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1.  INTRODUCTION 


The  SRI  PUFF  code  is  a  computer  program  for  calculating  one¬ 
dimensional  stress  wave  propagation  through  solid,  porous,  liquid,  or 
gaseous  materials.  The  stress  waves  being  computed  are  initialized  by 
the  deposition  of  radiated  energy  from  x-ray,  electron  beam,  or  laser 
sources;  impact  of  one  material  on  another;  detonation  of  an  explosive; 
or  by  prescription  of  a  pressure  or  velocity  history  at  a  boundary. 
Computations  are  made  with  the  Lagrangian  form  of  the  equations  of  motion 
so  that  the  coordinates  move  with  the  materials.  An  artificial  viscosity 
is  used  to  smear  wave  fronts  over  several  computational  cells. 

1.1  Background 

In  1950  von  Neumann  and  Richtmyer  (Ref.  1)  initiated  the  artificial 
viscosity  (or  Q)  method  for  solving  the  equations  of  wave  propagation. 

With  this  technique  infinitely  steep  shock  fronts  cannot  develop,  and 
the  entire  field  can  be  treated  as  one  of  continuous  flow.  Shock  fronts 
appear  as  regions  of  high  stress  gradient,  not  as  discontinuities.  The 
viscosity  tends  to  dampen  all  oscillations  or  perturbations  in  the  flow 
field.  Several  integration  schemes  based  on  the  Q  method  have  been 
developed,  notably  the  Lax-Wendroff  method  (Ref.  2),  the  Runge-Kutta-Gill 
method  (Ref.  3),  and  the  ’’leapfrog”  scheme  (Ref.  1)  which  is  used  by  most 
PUFF  codes. 

The  present  line  of  PUFF  codes  seems  to  have  originated  around  1958 
with  the  development  of  the  SHARK  (Ref.  4)  and  SHARP  (Ref.  5)  codes.  With 
later  developments  at  the  Air  Force  Special  Weapons  Center,  Kirtland  Air 
Force  Base,  the  generic  name  PUFF  was  given  to  the  program.  Recent  versions 
include  PUFF  (Refs.  6-8),  PUFF  III  (Ref.  9),  PUFF  IV  (Ref.  10),  PUFF  IV- EP 
(EP  for  elastic-plastic),  (Ref.  11),  PUFF  V-EP  (Ref.  12),  PUFF  VTS  (variable 
time  step),  (Ref.  13)  FOAM  PUFF  (Ref.  14),  PUFF  66  and  P  PUFF  66  (Ref.  15). 


1 


Most  of  the  PUFF  codes  have  been  described  in  classified  reports,  so  their 
characteristics  cannot  be  outlined  here.  A  useful  review  of  the  capa¬ 
bilities  of  each  of  these  codes  has  been  provided  by  Bothell  and  Archuleta 
(Ref.  11).  Other  PUFF- type  codes  are  available  under  the  names  of  WONDY 
(Ref.  16),  SRI  PUFF  (Ref.  17),  and  RIP  (Ref.  18).  RIP  is  a  well-documented 
code  with  special  capabilities  including  detailed  treatment  of  composite 
materials  and  laser  deposition.  All  the  PUFF-type  codes  use  artificial 
viscosity  with  the  leapfrog  integration  scheme.  The  SRI  PUFF  series  of 
codes  began  as  a  modification  of  the  PUFF  66  and  P  PUFF  66  codes. 

1.2  Scope 

This  volume  outlines  the  essential  theory  on  which  the  wave  propa¬ 
gation  calculations  of  the  SRI  PUFF  series  of  computer  programs  is  based 
and  describes  some  of  the  constitutive  models  (stress-strain  relations) 
currently  available.  The  constitutive  models  include  several  that  pro¬ 
vide  deviator  stress  only,  several  for  pressure  only,  and  several  that 
provide  a  combination  of  pressure  and  deviator  stress.  The  descriptions 
given  here  outline  the  simplest  constitutive  models  only,  indicate  sources 
for  information  on  the  others,  and  show  how  to  insert  additional  consti¬ 
tutive  models. 

The  current  version  of  SRI  PUFF  includes  the  features  of  earlier 
versions  plus  provisions  for  cylindrical  and  spherical  flow  as  well  as 
one-dimensional  planar  flow;  use  of  a  data  bank;  ductile  and  brittle 
fracture,  fragmentation,  and  shear  banding;  several  porous  material 
models;  a  hypoelastic  (variable  modulus);  a  cap  (advanced  plasticity) 
model;  detonation  by  constant  volume  explosion  or  by  running  detonation; 
improved  rezoning;  and  Coulomb-friction  without  dilatation. 

The  code  calculations  make  use  of  both  linear  and  quadratic  arti¬ 
ficial  viscosity.  An  integral  approach  is  used  to  solve  the  mass  and 
energy  conservation  relations.  The  stress  is  determined  from  the  equation 
of  state  or  constitutive  relations  for  known  volume  and  energy.  Because 
the  energy  is  not  known  at  the  time  stress  must  be  calculated,  an  energy 
estimate  is  made  and  then  adjusted  after  the  stress  calculation. 
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Since  its  outgrowth  from  PUFF  66  in  1967,  SRI  PUFF  has  undergone 
many  changes  and  is  expected  to  undergo  more.  The  code  is  written  in  a 
modular  form  so  that  initialization  and  running  are  usually  separated, 
deposition  problems  use  subroutines  that  are  unused  for  other  runs,  and 
constitutive  relations  are  in  separable  subroutines.  Thus  the  code  is 
planned  for  ease  of  change.  Subroutines  for  new  constitutive  relations 
can  be  added  as  new  material  models  are  generated. 

This  manual  is  intended  to  assist  not  only  the  users  of  the  program, 
but  also  those  who  wish  to  understand  it  well  enough  to  modify  it,  and 
those  who  wish  to  investigate  the  analytical  basis  of  the  program.  For 
users,  the  chapter  on  Initialization  (Section  5),  and  the  Appendices  C 
(Input)  and  J  (Glossary)  will  be  of  primary  interest.  Alterers  of  the 
program  may  notice  the  following  features:  a  brief  description  of  each 
subroutine  in  Section  2  and  a  discussion  of  major  subroutines  is  at  the 
end  of  Sections  2  through  6.  For  the  analyst,  the  bases  of  the  program 
are  discussed  in  Sections  3  through  5,  which  is  organized  around  certain 
fundamental  problems  in  the  program:  initializing,  integration  of  the 
propagation  equations,  equations  of  state,  and  so  forth.  The  order  of 
presentation  is  general  theory  first,  then  application  to  the  current 
analysis,  and  finally  details  of  implementation  in  the  program.  It  is 
hoped  that  this  organization  will  provide  answers  to  specific  questions 
about  the  program. 
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2.  ORGANIZATION  OF  THE  CODE 


2.1  Summary 

SRI  PUFF  8  is  a  one-dimensional  Lagrangian  hydrodynamic  program  for 
the  computation  of  stress  waves  caused  by  impact,  radiation  deposition, 
detonation  of  an  explosive,  or  prescription  of  a  stress  or  particle  velocity 
at  a  boundary.  The  numerical  integration  of  the  governing  equations  is 
carried  out  with  the  leapfrog  method  of  von  Neumann  and  Richtmyer.  The 
computations  proceed  by  increments  of  time.  For  each  increment,  a  cycle 
of  computations  is  made  throughout  the  active  regions  of  the  materials  to 
determine  stress,  particle  velocity,  specific  internal  energy,  density, 
sound  speed,  yield  strength,  pressure,  coordinate  location,  and  other 
variables.  The  primary  routines  of  the  program  are  SRI  PUFF  8  (overall 
control),  GENRAT  (initialization),  HYDRO  (control  of  wave  propagation 
calculations  for  each  cell),  HAFSTEP  (density  and  energy  calculations), 
and  HSTRESS  (control  of  stress  calculations). 

The  flow  of  program  control  is  illustrated  schematically  in  Figure  2.1, 
which  shows  the  interrelationship  between  the  subroutines  and  the  main 
program.  The  subroutines  are  grouped  according  to  type  of  activity. 

Thus  the  GENRAT  group  (GENRAT  plus  all  subroutines  with  arrows  from  GENRAT) 
initializes  and  the  HYDRO  group  (HYDRO,  HAFSTEP,  and  HSTRESS)  treats  propa¬ 
gation  and  stress  calculation.  The  arrows  designate  direction  of  calling. 

A  brief  description  of  the  work  of  each  subroutine  follows: 

•  SRI  PUFF  8,  the  main  program,  sets  the  size  of  each  time 
increment,  calls  HYDRO  to  perform  a  cycle  of  computations, 
and  calls  for  printout  and  resizing  of  cells. 

•  BANDRLX  computes  deviator  stresses  according  to  the  Band  or 
Gilman  stress-relaxation  models  (see  Ref.  19). 

•  BAUSCHI  computes  deviator  stresses  from  a  Bauschinger  model 
(see  Refs .  19,  20) . 

•  BECOM  and  BEMOD,  in  combination  with  STRESS,  compute  deviator 
stress  for  beryllium  according  to  a  stress-relaxing,  Bauschinger 
model  (see  Ref.  21). 
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FIGURE  2.1  FLOW  CHART  OF  SRI  PUFF  8 


•  BFRACT  computes  stress  and  crack  sizes  in  material  undergoing 
brittle  fracture  and  fragmentation  (see  Refs.  22-25). 

•  CAP1  computes  stress  and  tensile  fracture  in  materials  with 
a  combined  Mohr-Coulomb  yield  and  compaction  behavior 

(see  Ref .  33) . 

•  DEPOS  controls  deposition  of  radiant  energy  into  the  cell 
layout  during  initialization  (see  Section  5.4,  Appendix  A). 

•  DFRACT  computes  stress  and  void  growth  in  material  undergoing 
ductile  fracture  (see  Refs.  23,  26). 

•  EDIT  prints  a  listing  of  velocities,  stresses,  and  other 
variables  at  specified  times  (see  Section  6). 

•  EOSTAB  computes  pressure  from  a  table  of  pressures  as  a 
function  of  density  and  energy. 

•  EPLAS  computes  elastic  plastic  behavior  of  the  reinforcing 
steel  treated  in  the  REBAR  subroutine  (see  Ref.  33). 

•  EQST  provides  the  Mie-Gruneisen  and  PUFF  expansion  equations 
of  state  for  determining  pressure  (see  Section  4). 

•  EQSTPF  contains  the  Philco-Ford  equation  of  state,  which 
treats  explicitly  solid,  liquid,  and  gaseous  as  well  as 
mixed  phases  (see  Refs.  27,  28). 

•  ESA  is  an  equation  of  state  written  in  a  form  that  is  easy 
to  fit  to  experimental  data  (see  Ref.  28). 

•  EXPLODE  provides  the  equation  of  state  for  explosives  and 
for  constant  volume  or  running  detonation  (see  Appendix  B) . 

•  EXTRA  reads  in  additional  input  outside  the  normal  set  (see 
Appendix  C) . 

•  FMELT  computes  the  variation  of  strength  with  temperature 
(see  Appendix  D) . 

•  GENRAT  reads  or  controls  input,  and  initializes  arrays  and 
indicators  (see  Section  5). 

•  GRAY  provides  the  Gray  equation  of  state,  which  treats  explicitly 
solid,  liquid,  gaseous,  and  mixed  phases  (see  Refs.  28,  29). 

•  HAFSTEP  computes  density  and  estimates  internal  energy,  then 
calls  HSTRESS  for  the  stress  calculation  (see  Section  3). 

•  HDATA  reads  extra  input  lines  for  initializing  the  H(j,l) 
indicator  array, 

•  HSTRESS  computes  the  stresses  through  calls  to  appropriate 
subroutines.  All  constitutive  relations  are  reached  through 
the  calls  by  HSTRESS  (see  Sections  3,  4). 

•  HYDRO  conducts  each  cycle  of  calculations  through  the  coordinate 
array,  computes  coordinate  location  and  velocity,  and  calls 
HAFSTEP  for  midcell  calculations  (see  Section  3). 
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•  HYPO  computes  pressure  and  deviator  stress  from  a  variable 
modulus  or  hypoelastic  stress-strain  relation  (see  Ref.  30). 

•  PEST  provides  a  stress-strain  relation  for  porous  materials, 
including  strain-rate  effects,  hysteresis,  thermal  strength 
reduction,  and  fracture  (see  Ref.  28)* 

•  POREQST  computes  pressure  in  a  porous  material,  allowing  for 
hysteresis  and  thermal  strength  reduction  (see  Ref.  31). 

•  PORHOLT  computes  pressure  in  a  porous  material  according 
to  the  Holt  curve  for  compaction  (see  Refs.  32,  28). 

•  PRESCR  initializes  the  indicators  required  to  obtain  historical 
listings  (see  Appendix  C) . 

•  REBAR  computes  stresses  in  a  layered  composite  such  as  reinforced 
concrete  (see  Ref.  33). 

•  REDR  positions  the  tape  for  reading  when  input  is  from  a 
tape  file  (see  Appendix  C) . 

•  RELAX  computes  relaxation  of  the  deviator  stress  for  the 
anelastic  model  and  a  two-parameter,  varying  yield  model 
(see  Ref.  19). 

•  REZONE  resizes  the  cells  and  recomputes  all  coordinate 
quantities  (see  Appendix  E) . 

•  SCATTO  distributes  the  radiated  energy  of  a  depth-dose  profile 
into  the  cells  of  the  PUFF  layout  (see  Appendix  A) . 

•  SCRIBE  stores  historical  data  during  the  computation  and  pro¬ 
vides  stress  histories  at  selected  coordinates  and  at  each 
material  interface  at  the  end  of  each  computation  (see  Section  6) . 

•  SHEAR2  contains  stress-strain  relations  for  material  under¬ 
going  yielding  and  fragmentation  by  shear  banding  (see  Refs. 

34,  35). 

•  SIGMAT  provides  a  pressure  history  for  a  boundary  condition. 

•  SSCALH  computes  the  energy  deposited  at  midcell  points  during 
each  time  increment  in  which  radiation  is  occurring  (see 
Appendix  A) . 

•  STORR  stores  variables  during  the  calculation  for  the  historical 
listing  (see  Appendix  C) . 

•  STRES2  computes  the  deviator  stress  for  beryllium  from  a 
stress-relaxing,  Bauschinger  model  (see  Refs.  21,  36). 

•  TSQE  provides  a  computation  of  density  from  the  Mie-Gruneisen 
equation  of  state,  given  the  pressure  and  energy  (see  Ref.  28). 
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2 . 2  Main  Program:  SRI  PUFF  8 


The  main  program  controls  sequencing  of  the  operations  of  initial¬ 
ization,  calculation,  printout,  rezoning,  and  stopping  of  the  program. 

It  also  governs  the  time  increment.  The  order  of  operations  in  the  main 
program  is  as  follows: 


(1)  Call  GENRAT  to  read  data  and  initialize  COMMON  storage. 

(2)  Call  HYDRO  to  make  computations  of  all  array  variables 
at  each  time  increment. 

(3)  Call  STORR  to  store  data  from  HYDRO  cycle  for  later  printout. 

(4)  Check  whether  the  program  should  be  terminated  because: 

(a)  the  problem  time  (TIME)  has  exceeded  the  specified  stop 
time  TS;  (b)  the  number  of  cycles  N  has  exceeded  the  specified 
total  number  of  cycles  JCYCS;  (c)  the  coordinate  of  the  zone 
of  maximum  stress  has  exceeded  the  specified  coordinate  CKS; 
(d)  LSUB(7)  has  been  set  to  1  because  of  an  error  detected 
in  the  computations.  If  termination  is  indicated,  SCRIBE 
is  called  to  print  a  history  of  stresses.  Then  the  program 
returns  to  step  1  to  read  in  the  next  data  deck.  If  termina¬ 
tion  is  not  called  for,  the  program  continues  to  step  5. 

(5)  Calculate  next  time  increment  DTNH. 

(6)  Call  EDIT  for  printout  if  TIME  equals  one  of  the  TEDITS 
(input  quantities) . 

(7)  Call  REZONE  if  the  TIME  equals  a  TEDIT  time  designated  for 
rezoning  or  if  N  is  a  cycle  designated  for  periodic  rezoning. 

(8)  Prepare  for  the  next  EDIT  listing.  (After  completion  of  this 
sequence,  the  program  returns  to  step  2  for  the  next  call  to 
HYDRO.) 


The  time  increment  is  based  on  the  minimum  of  the  natural  time  steps 

allowed  (for  stability  of  the  calculations)  at  any  point  in  the  mesh. 

This  calculation  of  permitted  time  step  is  described  in  Section  3.4  on 

-12 

Propagation.  The  time  increment  is  initialized  in  GENRAT  at  10  second 
for  the  first  cycle.  Thereafter,  the  time  step  increases  gradually  in 
successive  cycles,  to  80%  of  the  natural  time  step.  The  increment  is 
never  required  to  be  less  than  2.8%  of  the  natural  time  step:  then,  if 
a  short  increment  occurs,  the  increment  returns  to  its  normal  value  within 
20  cycles. 
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To  ensure  that  an  adequate  number  of  cycles  occurs  during  the  radia¬ 
tion  deposition,  the  time  increment  during  deposition  is  required  not  to 
exceed  0.03  times  the  duration  of  any  currently  active  radiation  sources. 
After  deposition  is  complete  (TIME  >  SSTOPM) ,  SDURM  is  reset  to  1.0  to 
indicate  that  the  radiation  time  step  control  should  be  skipped. 
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3.  PROPAGATION  CALCULATIONS:  HYDRO  GROUP 


The  motion  and  stresses  throughout  the  material  are  determined  as 
a  function  of  time  in  the  code.  The  solution  is  obtained  by  solving  the 
mass,  momentum,  and  energy  conservation  relations  together  with  consti¬ 
tutive  relations  for  the  material.  This  section  presents  the  conserva¬ 
tion  relations  and  their  general  solutions  and  shows  specific  solutions 
for  interior  points  and  boundaries  of  material  layers. 

In  the  solution  procedure,  the  material  is  first  divided  into  dis¬ 
crete  units  or  cells.  Motions,  energies,  and  other  quantities  are 
initialized  in  cells  as  required  for  the  particular  problem.  Then  a 
time  step  is  taken  and  the  motions  and  stresses  are  calculated  for  each 
cell  using  the. conservation  and  constitutive  relations.  This  process 
of  stepping  forward  in  time  and  performing  calculations  for  each  cell  is 
repeated  until  the  time  has  reached  the  duration  of  interest.  The  time 
step  used  is  controlled  by  stability  and  smoothness  criteria  in  the  code. 
The  stability  considerations  are  described  in  this  section.  At  the  end 
of  the  section,  the  major  work  of  the  HYDRO  group.  (HYDRO,  HAFSTEP,  HSTRESS) 
is  summarized . 

3 . 1  Solution  Procedure  for  Wave  Propagation  Equations 

The  PUFF  programs  are  all  based  on  the  solution  of  the  Lagrangian 
equations  governing  one-dimensional  motion  of  a  continuous  medium.  The 
solution  technique  is  called  the  method  of  artificial  viscosity  because 
of  the  introduction  of  viscous  forces  to  permit  a  continuous-flow 
computation  in- regions  of  high-stress  gradients.  Such  regions  are  inter¬ 
preted  as  locations  of  shock  fronts,  although  no  discontinuities  occur 
in  the  computed  flow  field.  With  this  artificial  viscosity  method,  the 
equations  of  continuous  flow  can  be  used  everywhere  and  no  special  equa¬ 
tions  are  required  for  shock  fronts.  SRI  PUFF  uses  the  leapfrog 
method  of  von  Neumann  and  Richtmyer  to  integrate  the  flow  equations. 
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The  following  paragraphs  introduce  the  governing  differential  equations 
for  planar  flow.  These  are  changed  to  an  integral  form  for  solution  in 
the  program.  The  corresponding  equations  for  one-dimensional  cylindrical 
and  spherical  flow  are  given  in  Appendix  F. 

The  one-dimensional  planar  Lagrangian  differential  equations  to  be 
solved  are 


U 


2 

-  D  /3IJ\  or  equivalently 

D\9X/ 
o  <_ 


D  /D 
o 


(momentum) 


(velocity) 


(mass) 


(3.1) 


(3.2) 


(3.3) 


(3.4) 


where 


H  =  Lagrangian  coordinate  location  (original  position  in 
laboratory  coordinates) 

X  =  Eulerian  coordinate  location  (current  position  in 
laboratory  coordinates) 

t  =  time 

U  =  particle  velocity 

=  current  and  original  density 

R  =  total  mechanical  stress 

E  =  internal  energy 

E  .  =  radiated  energy 

rad 

V  =  D  =  specific  volume 
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These  equations  relate  velocity  to  the  coordinate  motion  and  provide 
for  conservation  of  momentum,  mass,  and  energy.  In  addition  to  these 
differential  equations,  there  is  an  equation  of  state  (or  constitutive 
relation  (which  is  a  relationship  between  stress  or  pressure  quantities 
and  the  density,  internal  energy,  history  of  loading,  and  so  forth. 

R  =  F(E,  D,  ...)  (equation  of  state)  (3.5) 

a  P  +  o'  +■  Q  (3.6) 

The  total  mechanical  stress  (in  the  direction  of  propagation),  R,  is 
composed  of  the  pressure  P,  the  deviator  stress  o'  in  the  direction  of 
propagation,  and  an  artificial  viscous  stress,  Q. 

In  the  code  the  five  preceding  equations  are  solved  simultaneously 
by  dividing  the  material  into  small  elements.  Then  the  quantities  X,  U, 

D,  R,  E,  and  so  forth,  are  evaluated  only  at  the  discrete  positions  and 
times  shown  in  Figure  3.1.  The  coordinate  quantities  X  and  U  are  obtained 
at  integral  values  of  j  and  n,  whereas  all  other  quantities  pertain  to 
the  midcell  (j+^,  n+%)  points.  Here  the  cells  are  treated  as  constant 
strain  finite  elements  (each  cell  has  a  constant  value  of  all  three 
principal  strains  throughout  its  volume).  This  derivation  contrasts 
slightly  with  the  finite  difference  approach  normally  used,  but  the 
resulting  equations  differ  only  for  cylindrical  and  spherical  flow  (see 
Appendix  F). 

The  discrete  values  of  the  flow  quantities  are  obtained  from  Eqs.  (3.1) 

through  (3.4),  using  the  nomenclature  of  Figure  3.1.  Here  it  is  convenient 

to  solve  for  quantities  in  the  order  D,  E,  R,  U,  and  X.  The  density  is 

obtained  from  conservation  of  mass  by  dividing  the  stored  value  of  the 

.  n+^  n  1 A  n+% 

cell  mass,  Z,  by  the  thickness  of  half  time,  t  =  t  +  -At 
The  first  form  of  Equation  (3.3)  is  not  used  here  because  it  can  give 
erroneous  results  for  large  density  changes;  instead,  the  second  form 
of  Equation  (3.3)  is  used: 
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FIGURE  3.1  GRID  FOR  DEPICTING  COORDINATES  AND  TIME  INCREMENTS 
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The  energy  conservation  relation  is  also  used  in  integral  form  rather 
than  relying  on  the  differential  form  of  Eq.  (3.4).  As  shown  in  the 
second  form  of  Eq.  (3.4),  the  strain  energy  term  is  the  stress  times  the 
volume  change . 


n+% 


R 


n-% 

\+h 


+  (ae.  ,  ) 


rad 


(3.8) 


For  correct  centering  of  the  equations,  the  stress  quantity  here  should 
be  Rn  obtained  by  averaging  Rn  2  and  Rn  2.  However,  Rn  2  is  obtained  in 
the  next  step;  hence,  Eq.  (3.8)  is  only  the  first  approximation  to  the 
energy.  The  complete  procedure  for  obtaining  energy  is  described  in 
Section  3.2.  The  stress  is  next  calculated  with  a  constitutive  relation 
represented  by  Eq.  (3.5).  Some  of  the  available  constitutive  relations 
are  described  in  Section  4. 

The  velocity  is  obtained  by  a  discretization  of  Eq .  (3.1),  or 
equivalently,  by  using  "force  equals  mass  times  acceleration”:  and  con¬ 
sidering  a  mass  pertaining  to  the  coordinate  point. 


U. 

J 


n+^  _  n+h 

n+l  _  n  _  j+%  , . n+k 


TT  -  _ _ J _ ± _ 

j  (Vi  +  Zj -h)n 


At 


(3.9) 


Finally,  the  Eulerian  position  of  the  coordinate  is  computed  from  Eq.  (3.2) 


+  U 


J 


(3.10) 


The  computations  proceed  from  left  to  right,  one  cell  and  coordinate  at 

.  ,  .  ,  ,  .  n+\  n+l 

a  time,  updating  the  flow  quantities  to  the  new  time  t  or  t  ,  as 

appropriate.  This  process  is  continued  until  the  right  boundary  is 

reached.  Then  computations  resume  at  the  left  for  the  next  time  increment. 
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The  foregoing  integration  method  is  essentially  the  leapfrog  method 
of  von  Neumann  and  Richtmyer.  With  this  approach  the  derivatives  in  the 
equations  of  mass,  momentum,  and  energy  are  correctly  centered.  That  is, 
each  of  the  conservation  relations  is  replaced  by  a  numerical  approxima¬ 
tion  in  which  all  terms  pertain  to  the  same  point  in  time  and  space.  For 
example,  in  the  momentum  equation  (3.9),  3U/3t  and  3R/3Z  are  both  centered 

precisely  at  (n+^,j),  and  therefore,  the  solution  scheme  is  of  second 

2  2  2  2 

order,  although  no  numerical  approximations  to  3  U/3t  or  3  R/3Z  are  needed. 


In  the  code,  the  names  of  quantities  are  essentially  those  given 
above  in  the  discretized  equations.  The  coordinate  quantities  are  U(j)  = 

^  and  X(j)  -  ^ ,  and  the  cell  quantities  are  of  the  form  RHL(j)  = 

R.  r*  The  time  step  is  DTNH  ®  Atn  2.  Hence  the  coordinate  point  and  the 
cell  to  the  right  are  both  labeled  J,  and  the  midcell  quantities  at  n+^ 
and  the  coordinate  quantities  at  n+1  are  stored  in  the  arrays.  Boundaries 
between  materials  are  treated  in  the  same  fashion  as  coordinates  within 
a  material  except  that  an  extra  coordinate  is  provided  to  permit  separa¬ 
tion  of  the  layers. 


3 . 2  Pressure-Energy  Calculation 

A  special  solution  method  for  obtaining  stress  and  energy  simulta¬ 
neously  was  necessary  to  permit  use  of  arbitrarily  complex  equations . 
of  state.  The  set  of  equations  governing  wave  propagation  includes 
expressions  for  pressure  as  a  function  of  energy  and  density  and  for 
energy  as  a  function  of  stress  and  density. 


P  =  P(E,p) 


(3.11) 


E  =  E  +  +  Ae  (3.12) 

°  l  e2  r 

where  AE  is  radiant  energy.  These  expressions  may  be  solved  simulta- 
r  ^  ^ 

neously  as  in  WONDY  if  the  pressure  function  is  linear  in  energy,  by 

multiple  calls  to  the  equation-of-s tate  routine  as  in  PUFF  66,^  or  by 

2  17 

extrapolation  as  in  a  two-step  integration  scheme.  *  A  combined  extrap¬ 
olation  and  simultaneous  solution  method  was  developed  for  use  in  the 
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current  one-step  integration  scheme  of  SRI  PUFF  8.  First  we  estimate 
the  internal  energy  at  the  current  step.  This  energy  is  used  to  com¬ 
pute  the  stress.  Then  these  provisional  values  of  stress  and  energy, 
plus  derivatives  of  the  pressure,  are  used  to  solve  simultaneously  for 
the  stress  and  internal  energy.  The  process  is  described  algebraically 
below:  it  is  implemented  in  HAFSTEP,  the  subroutine  that  computes  density 

and  energy  and  calls  HSTRESS  for  the  stress  calculation. 

The  total  mechanical  stress  R  and  the  internal  energy  E  are  the 
variables  to  be  determined.  The  stress  R  is  defined  as 


R  =  Q  +  a  =  Q  +  a"  +  P 


(3.13) 


where  Q,  a,  o',  and  P  are  the  artificial  viscous  stress,  thermodynamic 
stress,  deviatoric  stress,  and  pressure.  For  the  simultaneous  solution 


for  R  and  E,  R  is  presumed  to  be  derivable  from  the  previous  value  R^ 
and  the  pressure  derivatives  as  follows: 


(3.14) 


Thus  only  changes  in  P  are  considered;  changes  in  Q  and  0*  are  presumed 
to  be  small.  The  derivative  9P/9E  is  derived  analytically  from  the 


expression  for  pressure,  while  the  other  derivative  is  derived  from  the 
solution  of  Eq.  (3.14)  following  the  stress  determination  in  the  previous 
time  step. 


9P 

8p 


R  -  R  -  9P/9E  •  AE 


(3.15) 


Ap 


The  two  derivatives  have  approximately  the  following  values: 


(3,16) 


(3.17) 
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where  V  is  the  Grilneisen  ratio,  C  is  the  bulk  modulus,  and  p  is  the 

o 

initial  density.  The  estimate  of  internal  energy  E  is  made  by  evaluating 
Eq.  (3.2)  with  the  available  densities  and  p^  at  the  previous  and 
current  times,  the  average  of  stresses  R  and  R^  (using  Eq.  3.14),  and 
the  increment  of  radiant  energy  AE^ 


E" 


E  +  0.5 


a  8p 

Ap  +  9e 


AErj+  AEr 


(3.18) 


(This  is  the  actual  expression  used  instead  of  Eq.  (3.8).)  With  this 
value  of  internal  energy,  HSTRESS  is  called  to  compute  the  new  stresses: 
R  ,  O 2*  an^  P2*  s^multaneous  equations  to  be  solved  for  the  state 

variables  R^  and  E^  are  derived  from  Eqs.  (3.12)  and  (3.14). 


E 


2 


+  R2)  +  E 


1 


+  AE 

r 


(3.19) 


where  R^  and  E^  are  the  provisional  values.  The  simultaneous  solution 
of  Eqs.  (3.19)  and  (3.20)  provides  the  required  values  of  stress  and 
energy.  The  thermodynamic  stress  quantities  a  and  P  are  not  altered  but 
are  used  as  they  are  computed  in  HSTRESS. 

3 .3  Artificial  Viscous  Stress 

The  artificial  viscous  stress  is  required  in  finite  difference  wave 
propagation  calculations  to  smooth  out  shock  waves  so  that  the  entire 
flow  field  can  be  treated  by  the  conservation  equations  of  continuous 
flow,  Eqs.  (3.1)  through  (3.4).  The  artificial  viscous  stress  (Q)  is 
the  difference  between  the  nonequilibrium  mechanical  stress  (R)  and  the 
equilibrium  thermodynamic  stress  (a)  given  by  the  constitutive  relations. 
Hence  Q  represents  real  stresses  occurring  in  the  nonequilibrium  states 
of  the  shock  front.  But  the  basis  for  computing  Q  is  artificial,  depend¬ 
ing  on  the  computational  cell  size  and  on  viscosity  coefficients,  which 
are  not  related  to  real  physical  processes. 
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In  SRI  PUFF  the  usual  linear  and  quadratic  viscosity  forms  are  pro¬ 
vided.  The  linear  form  is  computed  by  the  equation 

Q  =  -  C,  C  pAU  (3.21) 

1  s 

where 

C 

s 

and  AU 

The  linear  artificial  viscosity  is  similar  in  form  and  operation  to  the 
standard  linear  viscosity  models  used  to  represent  material  behavior. 
However,  here,  the  coefficient  is  chosen  to  provide  enough  damping 
to  minimize  oscillations  in  the  calculations  and  not  to  represent  the 
real  material  viscosity.  In  the  code  is  given  different  values  for 
compressive  and  rarefaction  waves  so  that  less  damping  can  be  provided 
for  unloading  processes.  For  compression,  useful  values  are  in  the 
range  of  0.05  to  0.30;  for  rarefaction,  we  have  used  0.05. 

The  quadratic  artificial  viscosity  proposed  originally  by  von  Neumann 
and  Richtmyer  has  the  form 

Q  =  C2p(AU)2  (3.22) 

o 

2 

where  C  is  the  dimensionless  viscosity  coefficient,  and 
o 

AU  =  U  -  U  ,  as  before. 

j+1  i 

The  quadratic  viscosity  is  permitted  to  act  only  on  compressive  waves. 

2 

For  normal  values  of  C  of  3  or  4,  the  shock  front  is  rapidly  spread 

o 

over  three  to  four  cells  and  then  maintains  essentially  a  constant 
thickness  as  the  wave  propagates.  Because  of  the  quadratic  nature  of 
the  expression  for  Q,  very  little  damping  occurs  outside  the  shock  front. 
By  contrast,  the  linear  viscosity  tends  to  continue  to  erode  the  wave 
fronts  as  long  as  they  propagate. 

Normally,  both  linear  and  quadratic  artificial  viscosities  are  used, 
so  the  artificial  viscous  stress  Q  is  the  sum  of  the  linear  and  quadratic 
terms  from  Eqs.  (3.21  and  (3.22).  The  quadratic  viscosity  quickly 
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=  dimensionless  coefficient  of  linear  artificial  viscosity, 
=  sound  speed, 

=  Vi  ”  uj  • 


establishes  the  shock  front  thickness.  The  linear  viscosity  damps  the 
small  oscillations  that  would  otherwise  occur  near  the  shock  front,  but 
is  given  a  small  enough  coefficient  so  that  the  wave  front  is  not  seriously 
eroded . 

3 .4  Time-Step  Control 

For  the  calculations  to  proceed  in  a  stable  manner,  the  time  increment 
between  cycles  must  be  kept  smaller  than  that  given  by  the  Courant- 
Friedrichs-Lewy  condition  (see  Ref.  2,  p.  262).  This  criterion  is  simply 

At<^  (3.23) 

e 

where  AX  is  the  cell  size  and  C  is  the  local  effective  sound  speed 

e 

(defined  later) . 

The  criterion  means  that  the  time  step  cannot  be  so  large  that  the 
new  points  are  outside  the  characteristic  domain  of  dependence  of  the 
previous  points.  Referring  to  Figure  3.1,  the  new  point  (n+1,  j-1), 
for  which  the  variables  are  computed  from  values  at  (n,  j-2),  (n,j-l), 
and  (n,j), 

must  lie  within  the  domain  of  dependence  or  range  of  waves 
from  those  points.  This  domain  is  contained  between  lines  with  speeds 
of  C  «  A  physical  interpretation  of  the  requirement  is  that  a  wavelet 
cannot  be  allowed  to  proceed  from  one  coordinate  point  to  beyond  another 
in  one  time  step,  since  this  would  allow  a  material  point  to  "see,"  and 
be  affected  by,  conditions  at  material  points  outside  the  true  domain  of 
dependence.  This  simple  criterion  is  modified  to  provide  for  added 
safety  (the  time  step  used  is  80%  of  the  time  step  at  the  limit  of 
stability) ,  to  allow  for  the  effect  of  artificial  viscosity,  and  to 
allow  for  the  influence  of  high  particle  velocities. 

Artificial  viscosity  stiffens  the  material  and  therefore  increases 

the  apparent  sound  speed,  reducing  the  allowable  time  step.  For  linear 

2 

and  quadratic  viscosity  coefficients  (C  and  C  ),  Herrmann  et  al.  (Ref.  16, 

1  o 

p.  37)  derived  the  following  reduction  factor  F  to  be  applied  to  the  time 
step : 
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F  = 


(3.24) 


1  +  (Cj  +  c,,  ■  | AU I /Cq>  +  C1  +  C2  •  |au|/cc 


where  C  is  the  material  sound  speed  and  AU  is  the  change  in  particle 
s 

velocity  between  mesh  points.  To  speed  the  computation  by  eliminating 
the  square  root  process,  the  denominator  of  Eq .  (3.24)  is  approximated 
by 


V* 


I  +  CL  +  C„ 


a. 


1  1  0,5  L  +  CT 


(3.25) 


where  *  | AU | / C  because  should  be  a  small  fraction. 

Our  experience  with  radiation  deposition  computations  has  indicated 
that  instabilities  can  arise  when  the  particle  velocities  get  very  large. 
For  example,  in  the  vaporized  region  near  the  front  surface,  particle 
velocities  may  approach  or  exceed  sound  velocities.  In  such  cases  the 
usual  stability  criterion,  At  =  AX/C^,  is  no  longer  sufficient. 

Consider  the  X,  t  plot  in  Figure  3.2.  The  point  X^  is  the  inter¬ 
section  of  a  forward-going  sound  wave  from  (X_ ,  t  )  and  the  cell 

1  o 

boundary,  which  was  at  (X^,  tQ) .  Then 

XN  =  U2  At  +  X2  (3’26) 
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FIGURE  3.2  AN  X-t  PLOT  FOR  THE  TIME  STEP  COMPUTATION 


The  time  required  for  a  wave  to  travel  from  X  to 
the  cell,  is 


At 


f  dX 
j  U  +  Cs 


X^,  that  is, 


to  traverse 


(3.27) 


It  will  be  assumed  that  U  +  Cg  varies  linearly  from  to  so  that 

U+C  =  U.  +  C  .  +  T(U0  +  C  -  U.  -  C  )  (3.28) 

s  1  si  2  s2  1  si 


where  T  goes  from  0  to  1.  Then  dX  =  dT(xN  “  X^)  an<3  the  integral  is 


At 


*  <XN  -  V/ 


dT 


U  +  C 


XN‘X1 


c  0  +  u.  -  c  -  u 

s2  2  si  1 


<3-29) 
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where 


XN-X1 


In- 


i  +  y 


c  ,  +  U  -  C  -  U  1  -  y 

Si  2  S  -L  1 


Cs2  +  ”2  -  Csl  - 
7  '  Cs2  +  U2  +  Csl  +  "l 


The  series  expansion  of  the  logarithm  term  is  2(y  +  y  . 
the  first  term  is  used  here,  giving 


) .  Only 


At  = 


2<XN  -  V 


2<X2  +  U2At  -  xp 


(3.30) 


Cs2  +  U2  +  Csl  +  U1  Cs2  +  D2  +  Csl  +  U1 


When  the  At  terms  are  collected  on  the  left  side,  the  result  is 


At  = 


2<X2  -  X2) 


Cs2  +  Csl  +  °1  -  "2 


(3.31) 


If  the  value  of  At  computed  from  this  equation  is  negative,  the  two  paths 
do  not  intersect  and  At  can  be  set  to  an  arbitrarily  large  value.  The 
criterion  used  in  the  program  is  a  simple  combination  of  this  equation 
and  the  safety  factors,  (0.8  and  F)  ,  presented  earlier: 


At  =  0.8 


s2 


2  (X  -  X  )  F  \ 


(3.32) 


The  time-step  computations  are  begun  in  HSTRESS,  continued  in  HYDRO,  and 
completed  in  the  main  program. 

Note  that  an  effective  sound  speed  accounting  for  artificial  vis¬ 
cosity  and  particle  velocity  is 


C 

e 


c  +  c  +  u  -  u 

s2  si  1_ 2 


2F 


(3.33) 
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The  sound  sneed  is  required  only  to  control  the  time  step.  The 
analytical  expression  for  sound  speed  is 


(3.34) 


where  0,0'  are  the  stress  and  deviator  stress  in  the  direction  of  propa¬ 
gation  and  S  =  entropy;  as  a  subscript  it  means  that  the  derivative  is 
taken  at  constant  entropy.  The  elastic  or  low  stress  approximation  to  the 
sound  speed  of  compressional  waves  is 


C 


2 


s 


C  4  G 
p  3  p 


where  C  is  the  bulk  modulus  and  G  is  the  shear  modulus. 


(3.35) 


In  the  PUFF  code  the  sound  speed  is  used  only  to  determine  the 
permissible  size  of  the  next  time  step  and  to  compute  the  artificial 
viscosity.  The  minimum  time  is  governed  by  maximum  speed,  the  speed  of 
a  small  elastic  unloading  wave;  hence,  expressions  (3.34)  or  (3.35)  can 
be  evaluated  to  give  an  upper  bound  on  the  sound  speed.  Thus  9c^/9p 
or  G/p  is  computed  from  the  largest  shear  modulus  associated  with  the 
current  stress,  thereby  neglecting  that  the  material  may  be  at  yield  so 
the  effective  modulus  is  actually  zero. 

At  high  stress,  the  bulk  modulus  is  expected  to  increase  significantly, 
so  the  derivative  9P/9p  should  be  evaluated  instead  of  using  C/p.  A  pro¬ 
cedure  for  numerically  evaluating  the  partial  derivative  was  developed 
for  the  program.  The  first  law  of  thermodynamics  for  an  isentropic 
(dS  =  0)  process  is 


dE  =  -PdV  =  -Pd(h  (3.36) 

The  usual  rule  for  partial  differentiation  provides 
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dE  ■  (H)pdp  +(lf  )p  dp 


(3.37) 


From  these  two  equations  and  the  chain  rule 

-  (£  \  ■  (i)p(l)E 

the  required  derivative  is  obtained: 

dP  /  9P  \  ,  P_  /9P  \ 

dp  \  9p  p2  \3B/p 

The  derivative  dP/dp  was  taken  along  an  isentrope  and  therefore  is 
properly  written  (9P/9p)-. 

As  an  example  of  the  sound  speed  calculation,  the  derivative  is 
obtained  for  the  Mie-Griineisen  equation  with  Tp  a  constant. 

P  =  PR(1  -  Af)  +  rpE  (3.40) 

where 

2  3 

P  =  C  +  D  +  S  the  pressure  on  the  Hugoniot 

Hyp  y  ’  r 

C,  D,  S  =  material  constants  with  units  of  bulk  moduli 

T,  r  =  the  current  and  initial  values  of  Griineisen’s  ratio 

o 

y  -  P/PQ  "  1>  a  strain. 

Then  the  expression  for  sound  speed,  derived  from  Eq.  (3.39)  is 


(3.38) 


(3.39) 


25 


3 . 5  Outline  of  Subroutines 

The  subroutines  that  control  the  wave  propagation  calculations  and 
contain  the  equations  developed  in  this  section  are  HYDRO,  HAFSTEP,  and 
HSTRESS.  HYDRO  contains  the  position  and  particle  velocity  calculations, 
whereas  HAFSTEP  has  the  density  and  energy  calculations  as  well  as  the 
simultaneous  pressure-energy  solution.  HSTRESS  contains  the  artificial 
viscous  stress  (Q)  and  mechanical  stress  (R)  equations,  but  is  mainly  a 
switching  routine  for  selecting  appropriate  constitutive  relations  for 
each  material.  HYDRO  and  HAFSTEP  are  described  below.  Because  of  the 
involvement  with  constitutive  relations,  HSTRESS  is  described  in  Section  4 

HYDRO .  For  each  call  to  HYDRO  from  SRI  PUFF,  a  calculation  is  made 
for  all  cells  and  coordinates  which  are  currently  active.  HYDRO  contains 
separate  paths  for  the  several  coordinate  conditions  provided.  The  coordi 
nate  conditions  and  their  indicators  are: 

Normal  (N)  -  interior  coordinate  point  (within  a  layer  of  material) . 

Interface  (L,R)  -  left  and  right  coordinate  points  at  an  interface 
between  layers. 

Separated  interface  (S)  -  right  coordinate  point  at  a 

separated  interface.  First  and  last 
coordinates  are  treated  by  this  path. 

Mirror  or  reflective  boundary  (M)  -  a  constant-velocity  boundary 
(arbitrary  velocity  histories  should  be  imposed  by  modifying 
this  path) . 

Pressure  boundary  (P)  -  first  and  last  boundaries  may  have  a  pres¬ 
sure  history  with  a  shock  front  and  exponential  decay,  or  a 
history  provided  by  a  series  of  pressure  and  time  values. 
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Infinite  boundary  (I)  -  first  or  last  boundaries  are  treated  as 
if  a  mass  of  the  same  material  continued  indefinitely  to 
the  left  or  right  past  the  actual  first  or  last  coordinate 
points  (implemented  only  for  planar  case) . 

The  path  to  be  taken  for  each  coordinate  is  determined  by  an  indicator 
array,  H(J,2).  Values  of  the  indicator  are  given  above  in  parentheses 
following  the  path  title. 

In  each  path  a  call  is  first  made  to  HAFSTEP  to  compute  density, 
energy,  and  stress;  then  the  new  coordinate’s  position  and  velocity  are 
computed.  A  test  is  made  for  spallation  at  the  end  of  the  interface 
path  and  for  recombination  in  the  separated  path. 

At  the  end  of  HYDRO,  brief  calculations  are  made  to  determine  the 
largest  J  value  (JSTAR)  for  which  EDITs  should  be  printed  and  to  deter¬ 
mine  the  stable  time  step  for  the  next  cycle. 

HAFSTEP .  The  HAFSTEP  subroutine  is  called  by  HYDRO  for  each  cell 
and  each  time  step  to  compute  the  midcell  quantities  of  density,  energy, 
and  stress.  To  preserve  accuracy  in  the  stress  calculations,  the  time 
step  may  be  divided  into  small  intervals  (subcycles)  for  calculating  the 
midcell  quantities.  Not  more  than  1%  density  change  is  permitted  in  any 
subcycle.  This  subcycling  feature  is  important  for  constitutive  rela¬ 
tions  in  which  internal  energy  is  important  and  for  relations  based  on 
differentials . 

The  internal  energy  is  estimated  using  Eq.  (3.18)  and  then  HSTRESS 
is  called  for  the  stress  calculation.  Following  the  completion  of  HSTRESS, 
the  final  solution  is  made  for  energy  and  mechanical  stress  (R)  from 
Eqs.  (3.19)  and  (3.20).  The  derivatives  9P/8E  used  to  determine  the 
energy  estimate  are  computed  before  returning  to  HYDRO. 
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4 .  CONSTITUTIVE  RELATIONS 


The  constitutive  relations  provide  the  stress  as  a  function  of 
density,  strains,  internal  energy,  and  other  quantities.  This  section 
describes  the  common  constitutive  relations  and  outlines  the  available 
constitutive  models.  The  subroutine  HSTRESS,  which  selects  the  correct 
constitutive  subroutine  for  each  material,  is  also  described. 

4 . 1  Standard  Constitutive  Models 

In  the  standard  constitutive  relations,  the  stress  tensor  is  sepa¬ 
rated  into  a  pressure  and  a  stress  deviator  tensor.  The  pressure  is  the 
average  stress 


P  =  1/3  Zct  (4.1) 

1  11 

and  the  stress  deviator  elements  are 


(4.2) 


where  a  are  stress  tensor  elements  and  5  is  the  Kronecker  delta.  The 
ij  J 

pressure  is  usually  presented  as  a  function  of  density  and  internal  energy. 
The  deviator  stress  is  calculated  by  elastic,  plastic  relations,  which 
may  include  thermal  softening,  rate-dependent  effects,  and  work  hardening. 
The  standard  pressure  and  deviator  models  are  presented  in  the  following 
sections . 

4.1.1  Standard  Pressure  Models 

The  pressure  is  computed  from  a  simplified  form  of  an  equation  of 
state,  the  locus  of  all  possible  thermodynamic  equilibrium  states  for  a 
substance.  Each  state  is  a  set  of  values  of  the  following  thermodynamic 
quantities:  stress  tensor,  specific  volume,  entropy,  specific  internal 


29 


energy,  and  temperature.  In  the  simplified  equation  of  state  used  here 
and  in  most  wave  propagation  codes,  the  only  variables  considered  are 
pressure  (the  deviator  components  of  stress  are  treated  separately), 
specific  volume  (V)  or  density  (p  =  1/V) ,  and  internal  energy  (E) .  The 
equation  of  state  is  then 


P  =  P (E , V)  (4.3) 

which  defines  a  surface  or  locus  of  points  in  energy-pressure-volume 
space . 

An  equation  of  state  represents  equilibrium  states.  Therefore,  as 
a  material  undergoes  gradual  changes,  such  as  heating  or  compression, 
the  successive  states  describe  a  path  on  the  equation-of-state  surface. 

If  the  material  is  compressed  by  passing  through  a  steady-state  shock 
front,  the  initial  and  final  states  lie  on  the  P-V-E  surface.  These 
initial  and  final  states  are  connected  by  a  straight  line,  the  Rayleigh 
line,  which  does  not  lie  on  the  surface,  but  above  the  P-V-E  surface. 

The  states  of  transition  within  a  shock  front  are  not  states  of  thermo¬ 
dynamic  equilibrium.  The  equation  of  state  describes  the  material 
behavior  in  solid,  liquid,  and  gaseous  phases.  The  standard  pressure 
model  gives  a  detailed  treatment  of  the  solid  behavior,  but  the  other 
phases  are  described  by  approximate  relations  without  specific  determina¬ 
tion  of  the  particular  phase. 

First,  we  examine  the  paths  taken  on  the  equation-of-state  surface 
by  material  under  shock  loading.  Shock  experiments  lead  to  the  deter¬ 
mination  of  a  Hugoniot  or  Rankine-Hugoniot  equation  of  state  that  is 
represented  by  one  curve  on  the  equation-of-state  surface.  This  line 
is  the  locus  of  final  states  that  can  be  obtained  by  a  steady-state 
shock  transition  from  a  given  initial  state.  The  pressure-volume  path 
taken  by  the  material  during  the  shock  and  a  subsequent  unloading  is 
shown  in  Figure  4.1.  The  shock  path  follows,  a  Rayleigh  linef  to  a  point 
on  the  equation-of-state  surface.  Pressures  on  the  Rayleigh  line  can 
be  considered  to  be  decomposed  into  an  equilibrium  pressure  represented 
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NONEQUILIBRIUM 
SHOCK  PRESSURE 


PATH  ON  THE  EQUATION-OF-STATE  SURFACE 
RAYLEIGH  LINE  FOR  SHOCK  LOADING 

UNLOADING  ISENTROPE 


SPECIFIC  VOLUME 


M  A-6802-3 


FIGURE  4.1  PRESSURE  PATHS  FOR  SHOCK  LOADING  AND  UNLOADING  OF  A  MATERIAL 
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FIGURE  4.2  ENERGY-PRESSURE-VOLUME  (E-P-V)  SURFACE  FOR  A  SOLID  MATERIAL 
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by  a  point  on  the  equation-of-state  surface  plus  a  nonequilibrium 
pressure  component.  In  code  calculations  the  equilibrium  pressure  is 
computed  from  the  equation  of  statey  and  the  nonequilibrium  component 
is  computed  as  the  artificial  viscous  stress.  Figure  4.2  shows  the 
Rayleigh  line  and  unloading  isentrope  on  the  equation-of-state  surface 
with  a  Hugoniot  curve.  During  the  shock  loading  the  internal  energy 
increases,  as  indicated  in  this  figure.  Less  internal  energy  is  used  in 
the  elastic  recovery  on  unloading  down  the  isentrope;  hence  the  unloading 
does  not  coincide  with  loading,  and  the  final,  unloaded  state  is  warmer 
than  the  initial  state  and  at  a  larger  specific  volume  (for  materials 
that  expand  during  heating) . 

As  a  reminder  of  the  role  of  stress  in  the  compression  of  the  solid, 
consider  the  stress-volume  Hugoniot  of  Figure  4.3.  Here  only  the  stress 
component  in  the  direction  of  propagation  is  shown.  During  compression, 
the  stress  is  greater  than  the  pressure;  on  unloading,  the  stress 
decreases  rapidly  to  yielding  and  then  follows  a  stress  isentrope  below 
the  pressure  isentrope. 

Several  other  lines  of  interest  are  shown  in  Figure  4.2.  The  adia¬ 
batic  compression  path  is  followed  by  a  rapid  but  nonshock  loading  in  which 
no  heat  conduction  occurs.  The  unloading  isentrope  is  a  similar,  equil¬ 
ibrium  process  without  heat  conduction.  The  zero  pressure  line  is  the 
locus  of  points  obtained  by  simply  heating  the  material  without  external 
mechanical  confinement.  Heating  increases  the  internal  energy,  and 
thermal  expansion  occurs.  For  small  increases  in  internal  energy,  the 
zero  pressure  curve  describes  the  usual  expression  for  volumetric  thermal 
expansion 


V  =  V  (1  +  aA6)  (4.4) 

where  =  the  initial  specific  volume 

a  =  the  volumetric  thermal  expansion  coefficient 
A0  =  the  change  in  temperature. 
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STRESS  OR  PRESSURE 


G  A-6586  -22  A 


FIGURE  4.3  LOADING  AND  UNLOADING  PATHS  FOR  PRESSURE  AND  FOR  STRESS 
IN  THE  DIRECTION  OF  PROPAGATION 
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The  zero  pressure  curve  becomes  asymptotic  to  the  line  described  by 


E  =  vaporization  energy 
p  =  0 


for  large  V. 

The  spall  path  is  shown  only  to  indicate  the  direction  taken  in  tension. 
Spall,  or  fracture,  is  a  rate-dependent  process  that  generally  depends 
on  the  stress  tensor  (not  simply  the  pressure)  and  on  the  internal., 
energy.  Regions  where  the  energy  is  high  enough  that  the  material  is 
liquid  or  vapor  are  to  the  right  in  Figure  4.2.  The  vapor  region  extends 
indefinitely  to  the  right. 

The  equation-of-state  surface  depicted  in  Figure  4.2  is  an  idealized 
form  that  is  applicable  to  a  material  that  does  not  experience  solid 
phase  changes  or  other  phenomena  that  lead  to  regions  of  negative  curva¬ 
ture  in  the  P-V  plane.  While  this  surface  represents  the  material 
behavior  qualitatively,  only  certain  regions  of  the  surface  are  well 
understood  quantitatively.  The  best-understood  region  is  in  the  vicinity 
of  the  Hugoniot  because  of  the  availability  of  experimental  data  along 
that  curve.  The  least-understood  regions  are  those  near  spalling  and 

those  at  high  energies  and  to  the  right  of  V  =  V  . 

o 

Having  outlined  some  properties  of  the  equation  of  state,  we  now 
introduce  the  analytical  forms  used  in  the  standard  pressure  model.  In 
the  model  two  expressions  are  used:  one  for  compression  to  states  with 
density  greater  than  the  initial  density  and  one  for  extended  states. 

The  equation  used  to  describe  compression  is  the  Mie-Griineisen 
equation 


P 


 r<v) 


REF 


(E  -  eref> 


(4.5) 


where 
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REF  REF  =  a  point  on  some  reference  curve  at  the  same 

specific  volume  V 

T(V)  =  the  Griineisen  ratio. 

Equation  (4.5)  was  derived  by  assuming  that  T  is  a  function  of  V  only. 
Equation  (4.5)  provides  a  means  for  extending  the  information  of  a  known 
P-V  relation  (such  as  the  Hugoniot)  to  other  values  of  internal  energy. 
Because  the  Hugoniot  is  the  P-V  relation  that  is  most  likely  to  be  known, 
the  computations  are  constructed  so  that  the  Hugoniot  is  the  reference 
curve  used.  The  Hugoniot  P-V  equation  is  presumed  to  be  in  the  form 

P„  =  Cy  +  Dy2  +  Sy3  (4.6) 

H 


where 


C  =  bulk  modulus 

D,S  =  coefficients  with  the  units  of  moduli. 
The  internal  energy  along  the  Hugoniot  is 


eh  ■  %Vvo  -  V 


(4.7) 


Equation  (4.7)  assumes  that  the  initial  internal  energy  is  zero  and  that 
the  Hugoniot  is  concave  upward  throughout.  In  general,  the  latter  assump¬ 
tion  excludes  consideration  of  changes  of  state.  Although  the  relation 
is  strictly  true  only  for  the  stress  Hugoniot,  not  the  pressure  Hugoniot, 

little  inaccuracy  is  introduced  by  this  approximation.  With  the  aid  of 
Eqs .  (4.6)  and  (4.7),  the  Mie-Griineisen  equation  takes  the  following  form 
in  the  program 

P  =  (Cy  +  Dy2  +  Sy3)(l  -  p)  +  TpE  (4.8) 
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When  material  is  held  at  a  particular  volume  and  heated  (internal 
energy  is  added),  it  goes  through  states  that  are  straight  lines  on  the 
equation-of-state  surface.  This  indicates  that,  for  constant  volume  , 
the  analytical  equations  for  the  surface  have  the  form 

E  =  A(V1>  •  P  (4.9) 

where  A(V^)  =  a  function  of  only.  The  equation-of-state  surface  is 
constructed  simply  by  translating  the  Hugoniot  curve  parallel  to  itself 
to  higher  energy  states.  The  line  V  =  V  is  the  boundary  between  the 
Mie-Griineisen  equation  and  an  expansion  equation. 

The  expansion  equation,  which  is  similar  to  that  used  in  PUFF  66, 
must  meet  four  requirements.  It  must: 

•  Join  smoothly  to  the  Mie-Griineisen  equation  along  V  =  V  . 

o 

•  Expand  like  PV  =  E(y  -  1)  at  large  expansions  (like  a  perfect 
gas)  . 

•  Provide  a  linear  relation  between  P  and  E  for  constant  V. 

•  Account  for  the  partition  of  internal  energy  into  components 
for  kinetic  energy  and  for  vaporization  energy. 


The  equation  that  satisfies  these  requirements  is 


P  =  pF  j  E  -  E  / 1  -  exp 


P  P 

N(1  -  — )  80 


P  P 


(4.10) 


where 


p,p  =  current  and  initial  density 


so 


r  =  h 

e 


+  (r  -  H)  /— 2—  j  #  the  effective  Griiineisen  ratio  for 
-°-  J  ^ so 


expanded  states, 

H  =  y  -  1  for  expansion  at  low  densities  and  y  is  the 
polytropic  gas  exponent 


E  =  E  in  general 

G  S 


=  E 


1  +  ln(tr~)|  f°r  E  >  E  and  n  ^  0.5 


E  =  sublimation  energy  for  metals 


=  incipient  vaporization  energy  for  mixed-oxide  ceramics < 
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n  =  a  constant,  usually  0.5  for  metals,  1.67  for  mixed-oxide  ceramics 


N  = 


rr-ir ri  ■ 0 


o  so  e 


r  p  e 

0  so  e 


+ 


Min(E,Eg) 


[rl 

/H  ..  \ 

—  +  n 

- - 1 ) 

r 

\r  / 

_  o 

o 

for  r  *  0 


T  +  the  effective  Griineisen  ratio  for  p  p 

o  1  so 


r 

C  =  coefficient  in  Eq .  (4.6),  the  bulk  modulus  at  low  pressures. 


The  present  expansion  equation  differs  from  that  in  PUFF  66  because  of 
improvements  in  N  to  provide  continuity  of  9P/9V  at  p  =  p  with  the 
Mie-Griineisen  relation  and  to  provide  a  variable  vaporization  energy, 
which  seems  to  be  required  for  some  materials. 

As  an  indication  of  the  shape  of  the  P-V-E  surface  generated  by  the 
expansion  equation,  several  pressure-volume  curves  are  given  in  Figure  4.4 
for  aluminum.  Note  that  the  curves  are  all  continuous  at  p  =  2.7,  the 
density  at  which  the  joint  to  the  Mie-Griineisen  equation  occurs.  The 
expansion  equation  permits  a  large  tensile  pressure  excursion  at  low 
internal  energies  and  then,  for  decreasing  densities,  gradually  takes  on 
the  form  of  a  perfect  gas  law.  Figure  4.5  exhibits  the  modified  PUFF 
expansion  equation  (typical  of  a  mixed-oxide  ceramic)  in  P-V-E  space  for 
compressive  states.  The  initial  solid  (SO),  solid  melt  (SM) ,  and  liquid 
boil  (LB)  points  are  labeled. 

Many  of  the  equation-of-state  parameters  are  available  in  standard 

handbooks.  For  example,  C  is  the  isentropic  bulk  modulus  at  low  pres- 
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sures.  According  to  Rice,  McQueen,  and  Walsh,  D  in  Eq .  (4.6)  may  be 

estimated  from  D  =  I^C .  The  sublimation  energy,  Eg,  is  the  difference 

between  the  internal  energy  of  the  solid  material  at  ambient  conditions 

and  the  internal  energy  of  the  fully  expanded  vapor  at  a  temperature  of 

0  38 

absolute  zero.  This  quantity  is  referred  to  as  AH_  in  the  JANAF  tables 

f  o 

for  the  gas  state. 

The  Griineisen  ratio  Y  may  be  estimated  from  thermal  expansion  data, 
using  the  relation 
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PRESSURE 


FIGURE  4.5  SKETCH  OF  MIE-GRUNEISEN  AND  MODIFIED  PUFF-EXPANSION  EQUATION- 
OF-STATE  MODEL 
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=  Cr* 


(4 .11) 


where 


Oi  =  the  volumetric  thermal  expansion  coefficient 

C  =  the  specific  heat  at  constant  pressure. 

P 

The  result  from  Eq.  (4.11)  should  be  relied  on  only  if  all  quantities 
pertain  to  the  same  density,  pressure,  and  temperature.  For  many 
materials,  V  lies  between  1.0  and  2.0;  if  internal  energy  is  not  important 
in  the  problem,  an  estimate  can  be  made  in  this  range. 

The  Hugoniot  form  traditionally  used  with  PUFF  calculations  is  the 

three-term  expansion  in  Eq.  (4.6).  At  large  strains  this  form  has  the 

disadvantage  that  it  does  not  have  a  physically  reasonable  behavior, 

especially  if  some  of  the  coefficients  are  negative.  Two  alternative 

Hugoniot  forms  are  discussed  here:  the  Murnaghan  form  and  the  linear 

U  -  U  relation.  Both  are  provided  as  options  in  the  standard  pres- 
s  p 

sure  model. 

The  Murnaghan  equation  for  the  Hugoniot  results  from  an  integration 
of  the  following  linear  expression  for  bulk  modulus. 


(4.12) 


=  a  +  bP 


where  the  derivative  is  taken  along  the  Hugoniot,  V  is  the  specific 
volume,  P  is  pressure,  and  a  and  b  are  constants.  On  integration  of 
Eq.  (4.12),  the  Hugoniot  pressure  is  obtained  in  the  Murnaghan  form 


This  form  has  the  distinct  advantage  over  (4.6)  in  always  increasing 
monotonically .  Hence,  if  it  is  used  for  pressures  somewhat  above  the 
data  on  which  the  fitting  parameters  a  and  b  are  based,  the  computed 
pressures  should  be  physically  reasonable.  The  data  from  many  materials 
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have  been  shown  to  fit  this  Murnaghan  form  well.  The  parameters  a  and  b 
can  be  easily  related  to  the  coefficients  in  Eq .  (4.6)  by  taking  the 
derivatives  of  (4.6)  with  respect  to  volume  and  comparing  terms.  From 
Eq .  (4.6) 


-V 


=  C  +  y(C  +  2D)  +  y  (3S  4-  2D)  + 


(4.14) 


Eq .  (4.12)  can  be  expanded  to 

-V  (||^  =  a  +  b(Cy  +  Dy2  +  Sy3) 


(4.15) 


Therefore 


a  =  C 

b  =  1  +  2D/C 


(4.16) 


Another  estimate  of  b  is  obtained  from  the  Rice,  McQueen,  and  Walsh 
relation  V  =  D/C. 

Then 

b  =  1  +  2T  (4.17) 


For  many  solids  the  value  of  b  is  approximately  5. 

Shock  wave  data  are  often  presented  in  the  form  of  a  linear  relation 
between  shock  velocity  (U  )  and  particle  velocity  (U) .  The  basic  rela¬ 
tion  is 


U 

s 


CL  +  SLU 


(4.18) 


where  C  and  S  are  parameters  determined  by  the  fit  to  data.  For  a 

Li  Li 

material  with  no  deviator  stresses,  the  pressure  from  Eq .  (4.18)  is 


P 


H 


p  UU 
o  s 


=  p  (C  U  +  S  U2) 
o  L  L 


(4.19) 
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Next  we  replace  the  velocities  by  using  the  expression  for  the  conserva¬ 
tion  of  mass  across  a  shock  front 


and  a  Lagrangian  strain  e 


e  =  1  -  p  /p 

O 


(4.20) 


(4.21) 


By  combining  the  foregoing  four  equations,  we  determine  the  Hugoniot 
pressure  as  a  function  of  strain 


2 

P  C_e 

o  L 


H  a-v>2 


(4.22) 


This  is  the  form  used  in  calculations.  By  an  expansion  of  the  term  in 
Eq.  (4.22)  and  comparison  of  coefficients  with  those  in  Eq.  (4.6),  it 
can  be  shown  that 


=  ^+d 


(4.23) 


C 


L 


(4.24) 


From  Eq.  (4.23)  and  the  standard  value  of  2  for  T  =  D/C,  it  is  expected 
that  S  is  approximately  1,5.  The  value  of  C  is  simply  the  bulk  sound 

Li  h 

speed  at  low  pressures. 

4.1.2  Standard  Deviator  Stress  Model 

The  deviator  stress  is  the  part  of  the  stress  tensor  that  arises 
because  of  the  resistance  of  the  material  to  shearing  deformation.  In 
PUFF  the  standard  model  for  deviator  stresses  accounts  for  elastic 
response,  plastic  flow,  work  hardening,  and  thermal  softening.  The  yield 
strength  that  governs  plastic  flow  can  be  either  of  the  Mises  or  Coulomb 

types.  Here  the  relations  are  developed  in  a  general  form  applicable 
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to  planar,  cylindrical,  or  spherical  flow.  More  advanced  deviator  models 
are  found  in  Appendix  G.  Simplified  forms  specifically  applicable  to 
planar,  cylindrical,  and  spherical  flow  are  in  Appendix  F. 


Elastic  Relations.  The  elastic  relations  between  stress  and  strain 
are  cast  in  the  following  form 


o' . 
ij 


2G(  e 


E  _  JLj_, 

ij 


Ee 


Us 


(4.25) 


P  =  CEe. . 

11 


(4.26) 


E 

Here,  O '  and  £ .  .  are  the  deviatoric  stress  and  elastic  strain  in  the 

ij  U 

ij  direction,  G  is  the  shear  modulus,  6..  is  the  Kronecker  delta,  P  is 

1 J  e 

pressure,  and  C  is  the  bulk  modulus.  For  the  elastic  case,  =  £ , . , 

il  11 

all  the  strain  is  elastic.  But  Eqs.  (4.25)  and  (4.26)  are  also  appli¬ 
cable  to  the  plastic  case  where  the  strain  increments  are  separated  into 
elastic  and  plastic  components. 


de . .  =  deE.  +  de?  (4.27) 

ij  i 1  ij 

where  de  is  the  total  strain  increment  and  de^  is  the  plastic  strain 

ij  ij 

increment.  For  convenience,  the  terms  in  the  parentheses  of  Eq .  (4.25) 
can  be  named  a  deviator  strain  defined  as  follows: 


11 


E 

e .  . 

il 


n 


(4.28) 


Then  Eq .  (4.25)  becomes 


a:.  =  2G  e;E  (4.29) 

1 1  ij 


Plastic  Relations.  The  Reuss  plasticity  relations  or  "incremental 
plasticity  with  an  associated  flow  rule"  are  considered  here  first. 
Modifications  to  treat  Coulomb  friction  are  described  later.  Yield 
occurs  when  the  effective  stress  reaches  the  yield  strength.  The 
effective  stress  is 
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a 


(4.30) 


°«) 

where  the  repeated  subscripts  indicate  summation.  The  yield  criterion 
is 


O  =  Y  (4.31) 

where  Y  is  the  current  yield  strength.  The  Reuss  flow  rule  indicates 
that  the  deviator  stress  in  any  direction  is  proportional  to  the  plastic 
strain  in  that  direction: 


dX 


(4.32) 


where  dX  is  a  proportionality  constant.  Now  we  define  a  scalar  plastic 
strain  quantity  as  follows: 


(4.33) 


As  before,  the  repeated  subscripts  indicate  summation.  Now  we  square 
Eq.  (4.32)  and  make  use  of  the  definitions  of  a  and  de^.  Then 


P 


de 


dX 


(4.34) 


Combining  this  definition  with  Eq.  (4.32),  we  find  that 


P 

3de 

20 


(4.35) 


To  obtain  a  solution  for  an  increment  of  strain,  we  compute  first  the 
stress  that  would  occur  if  the  strain  were  entirely  elastic,  that  is, 

°ij  =  2G  (Cijo  +  Aeij)  =  2G  (eij  +  Aeij  )  (4-36) 
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where 


Ijo 

4e« 

Aeii 


the  elastic  deviator  up  to  the  current  strain  step 
the  total  deviator  strain  increment 

the  elastic  deviator  strain  after  the  current  increment 
the  plastic  strain  increment. 


The  second  equality  in  Eq .  (4.36)  is  obtained  by  using  Eq.  (4.27) 
to  decompose  A  e'  and  by  adding  e  ^  \  j  to  °ktai-n  .  Quantities 

z'  and  Ae,  ,  can  both  be  replaced  by  stress  quantities  through  the  use 
il  i  j 

of  Eq .  (4.29)  and  Eq.  (4.35).  Then, 


aij  =  aij  (1  +  3GdeP/CTj’  (4.37) 

-N 

If  both  sides  of  Eq.  (4.37)  are  squared  and  a  quantity  a  is  introduced 
in  analogy  to  the  definition  of  cr,  then  we  obtain 


aN  =  a(  1  +  3Gdep/a) 


(4.38) 


Here,  a  =  Y. 


Combining  Eqs. 


(4.37)  and  (4.38)  yields  a  solution  for  a 


ij 


a" 

ij 


- 

a  a 


ij 
J  a 


(4.39) 


Then,  the 
effective 


elastic  strain  can  be  obtained  from 
plastic  strain  from  Eq.  (4.38) 

-N 


d£P 


Eq. 


(4.39)  and  the 


(4.40) 


and  finally,  each  component  of  plastic  strain  is  found  from  Eq .  (4.32). 

The  preceding  process  is  especially  appropriate  for  perfect  plasti¬ 
city  where  Y  is  constant.  The  equations  are  appropriate  for  steps  from 
one  plastic  state  to  another  or  from  an  elastic  state  to  a  plastic  state. 
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When  Coulomb  friction  is  introduced,  the  preceding  equations  for 
Mises  plasticity  are  modified  slightly.  The  fundamental  relation  pro¬ 
vides  a  shear  yield  stress  x  ,  which  is  a  function  of  a  cohesion  c, 
normal  stress  q  ,  and  the  angle  of  internal  friction  (j) 


T  =  c  +  a  tan  d) 
c  h 


(4.41) 
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Following  Terzaghi,  this  expression  is  transformed  to 


cr  =  2c  /n,  +  cr  n 

1  v  cp  " 


3  <J> 


(4.42) 


where  N  =  tan^(45°  +  cf)/2);  and  a  and  o  are  the  most  and  least  com- 

T  13 

pressive  principal  stresses.  In  the  derivation  we  consider  that  yielding 
has  no  effect  on  volume  change  (a  Coulomb-without-dilation  model) . 

Instead  of  using  Eq .  (4.42),  which  is  not  symmetric  because  the  inter¬ 
mediate  principal  stress  is  absent,  we  introduce  the  expression  of 
40 

Drucker  and  Prager 


\/J'2  =  k  +  3aP 


(4.43) 


where  is  the  second  invariant  of  the  stress  deviator  tensor,  and 
k  and  a  are  constants.  Replacing  by  the  effective  stress  a  =  >/3J^, 

we  can  obtain  the  following  form  for  Eq .  (4.43) 


-  3c  A,+  2%  - 1)p 


(4.44) 


1  +  ^J2 

<P 


The  constants  k  and  a  have  been  replaced  by  c  and  by  equating  Eqs . 
(4.42)  and  (4.43)  for  the  case  a ^  =  0^ .  The  individual  deviator  stresses 
are  then  obtained  from  Eq .  (4.39). 

Work  Hardening.  A  linear  work  hardening  is  assumed  in  the  following 


form: 


Y  =  Yo  +  ydIapI 


(4.45) 
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where  Y  is  a  work-hardening  coefficient  with  the  units  of  dyn/cm  /(g/cm  ). 
D 

This  form  is  used  mainly  for  historical  reasons  because  it  was  present 
in  PUFF  66.  The  input  value  of  is  discussed  in  Section  5.5.  The 
present  formulation  is  satisfactory  for  planar  flow  in  which  all  strain 
is  related  to  density  changes.  More  appropriate  work-hardening  processes 
for  other  flows  are  discussed  in  Appendix  G. 


Thermal  Softening .  Material  that  is  heated  to  an  internal  energy  near 
melting  generally  loses  considerable  strength.  In  PUFF,  thermal  soften¬ 
ing  is  permitted  to  reduce  both  the  yield  strength  and  the  shear  modulus 
of  a  material.  Physically  each  of  these  parameters  probably  reduces  as 
a  different  function  of  the  temperature.  Figure  4.6  shows  stress-strain 
relations  for  two  possible  thermal  softening  relations.  In  each  case, 
it  is  assumed  that  the  material  has  been  loaded  through  yielding  to  the 
point  labeled  Y^  and  then  heated  sufficiently  to  produce  a  decrease  in 
yield  and  modulus.  For  the  case  where  the  thermal  softening  functions 

F  and  F  for  both  yield  Y  and  modulus  G  are  equal,  complete  elastic 
Y  G 

unloading  from  either  point  Y  or  point  Y^  would  reach  the  same  value 

of  shear  strain;  hence  no  change  in  plastic  strain  is  involved. 

However,  when  F  is  not  equal  to  F  ,  some  adjustment  occurs  in  e^,  as 
Y  G  _ 

shown.  When  F  is  greater  than  F  ,  there  is  an  apparent  increase  in  £  , 

G  i 

although  no  strain  has  actually  occurred  in  proceeding  from  point  Y^  to 
point  Y  .  In  the  code  calculations,  different  thermal  reduction  functions 
are  permitted  for  Y  and  G;  however,  no  adjustment  is  made  in  £^. 


4 . 2  Constitutive  Model  Types  and  Switching  Routine  for  Selecting  Models 


Constitutive  or  material  models  may  take  many  forms  besides  the 
standard  types  presented  above.  Some  of  the  available  nonstandard  models 
are  introduced  here,  and  the  routine  for  calling  them  in  the  code  is 
described.  Procedures  for  inserting  new  models  are  described  in  Appendix  H. 


Our  work  in  porous  materials,  fracture,  composites,  and  explosives 
has  led  us  to  require  the  use  of  very  general  material  models.  PUFF 
models  have  been  constructed  to  reflect  these  requirements.  For  example, 
a  porous  material  may  consolidate;  therefore,  calculations  should  be 
able  to  begin  with  the  porous  material  model,  but  transfer  to  a  solid 
model  after  consolidation.  For  fracture  calculations  it  should  be 
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(a)  EQUAL  THERMAL -SOFTENING  FUNCTIONS 


(b)  UNEQUAL  THERMAL-SOFTENING  FUNCTIONS 

MA-3503  21  A 

FIGURE  4.6  EFFECTS  OF  YIELD  AND  MODULUS  THERMAL-SOFTENING 
FUNCTIONS  ON  PURE  SHEAR  STRESS-STRAIN  RELATIONS 
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possible  to  treat  the  material  with  a  continuum  model  up  to  incipient 
fracture  and  then  transfer  to  a  fracture  model.  Furthermore,  the 
material  state  should  determine  which  type  of  fracture  model  to  call. 
Composites  should  be  simulated  either  by  a  single  model  or  by  a  combi¬ 
nation  of  models  representing  the  constituents.  If  pressure  and 
deviator  stresses  are  treated  separately  for  the  material,  then  any 
pressure  model  should  be  combinable  with  any  deviator  model.  These 
general  requirements  have  been  followed  in  setting  up  the  model  types. 

At  present,  five  model  types  are  accounted  for  in  PUFF. 

•  Composite,  for  multiconstituent  materials.  Total 
stresses  are  computed  by  the  model. 

•  Fracture.  A  continuum  model  is  called  until  fracture 
begins.  The  use  of  a  fracture  model  is  triggered  by  a 
criterion  preceding  the  CALL  statement.  Total  stresses 
are  computed. 

•  Porous,  Either  total  stress  or  pressure  are  computed, 
depending  on  the  model.  At  consolidation,  transfer  may 
occur  to  a  continuum  model. 

•  Deviator,  Only  deviator  stresses  are  computed,  so  one 
of  these  models  is  used  in  conjunction  with  a  pressure 
model . 

•  Pressure.  Only  pressure  is  computed.  Explosives  are 
treated  under  this  heading. 

Occasionally  still  greater  flexibility  is  required  in  modeling 
complex  materials.  For  example,  it  may  be  necessary  to  use  a  particular 
deviator  model  first  with  a  pressure  model  and  then  as  part  of  a  frac¬ 
ture  model.  Or  it  may  be  desirable  to  call  a  fracture  model  from  a 
porous  model.  The  capability  of  calling  any  model  subroutine  from  any 
other  routine  is  made  possible  by  eliminating  the  COMMON  variables 
from  all  models.  All  information  enters  each  subroutine  through  its 
CALL  statement.  Hence  special  combinations  of  models  can  be  obtained 
fairly  readily  with  small  changes  in  the  program.  Some  guidance  on 
making  such  changes  is  included  in  Appendix  H. 

The  subroutine  HSTRESS  has  been  constructed  to  serve  as  a  switch 
between  the  various  subroutines  computing  pressure,  deviator  stress, 
and  total  stress.  The  flow  chart  in  Figure  4.7  emphasizes  these 
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-—►(300J  Pressure  from  extended  equation  of  state 
Philco-Ford  equation  of  state 
Hypoelastic  equation  of  state 
GRAY  equation  of  state 

Tabular  equation  of  state 
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FIGURE  4.7  FLOW  CHART  OF  HSTRESS,  STRESS-SWITCHING  ROUTINE 
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Deviator  stress  is  zero  for 
molten  or  gaseous  material 


Deviator  stress  routes 


MA-6802-8 


FIGURE  4.7  FLOW  CHART  OF  HSTRESS,  STRESS-SWITCHING  ROUTINE  (Concluded) 
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stress-switching  features.  Material  models  that  are  currently  avail¬ 
able  are  listed  in  the  figure  and  in  Section  2.  The  list  in  Section  2 
also  shows  where  to  find  more  information  about  each  model. 

4 .3  Spall  Calculations 

A  simple  spall  model  is  provided  to  permit  material  separation  when 
the  stress  exceeds  a  critical  level,  T  .  The  spall  criterion  is  checked 

J 

and  separation  calculations  are  made  in  HSTRESS  following  the  normal 
stress  calculations . 

The  spall  criterion  is  based  on  R  =  +  Q  in  the  direction  of 

propagation  and  on  and  a in  the  other  two  directions.  The  stresses 
in  the  three  directions  are 


(1)  R  =  0'1  +  Q  =  0,^  +  P  +  Q  =  SDH  +  PHL  +  Q 


=  o'  +  P  =  -  +  P  for  planar  and  spherical 

=  P  +  =  PHL  +  SDT  for  cylindrical 


(3)  =  a ^  for  planar  and  spherical 

=  P  ~  ~  a2  =  PHL  ~  SDH  ""  SDT  for  cylindrical 


The  first  step  in  the  spall  calculations  is  to  compare  the  stresses  in 


all  three  directions  with  the  spall  criterion  T  . 


If  spall  has  occurred  in  any  direction,  the  stress  in  that  direc¬ 
tion  is  zeroed  and  elastic  rebound  (recompression)  occurs  in  the  other 
two  directions.  The  final  stress  configuration  is  obtained  by  applying 


allowing  only  strain  (opening)  in  the  spall  direction,  the  pressure  and 
deviator  components  are  computed  from  the  usual  elastic  relations  for 
planar  flow. 


AP 


f 


(4.46) 
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(4.47) 


The  change  in  deviator  stress  in  the  other  two  directions  is  -  Aa^/2. 
From  these  relations,  the  final  stresses  in  the  three  principal  direc¬ 
tions  are  computed. 

a  -*  0 

f  f 

a,  a  -  AP  +  %A o' 

3  i  i 

a  a  -  APf  +  %Aa"f 

k  k  i 


Similarly,  the  pressure  becomes  P  -  AP  and  the  deviators  are  modified 
as  follows 


J 


a 


k 


+  %A a 
J 


"f 

>f 


+  %Aa^f 


The  spall  model  now  in  PUFF  correctly  treats  spallation  and  continued 
separation.  Since  separation  strain  is  not  stored,  reconsolidation  is 
determined  only  by  a  return  to  a  consolidated  density.  Spall  is  permitted 
in  only  one  direction  at  a  time. 
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5.  INITIALIZATION:  THE  GENRAT  GROUP 


The  GENRAT  subroutine  is  called  once  at  the  beginning  of  each 
problem  to  read  in  all  the  data  and  initialize  the  COMMON  storage.  The 
GENRAT  group  includes  DEPOS ,  EXTRA,  HDATA,  PRESCR,  REDR,  SCATTO.  The 
sequence  of  major  operations  conducted  by  these  subroutines  is: 


•  Read  general  running  instructions  for  the  problem 

•  Read  properties  for  each  material 

•  Lay  out  a  coordinate  grid  over  all  the  materials 

•  Compute  the  absorption  of  radiated  energy  (for  a  radiation 
problem) 

•  Initialize  the  coordinate  and  cell  arrays 

•  Print  initial  coordinate  values. 

This  section  describes  the  philosophy  of  the  input,  shows  the  derivation 
of  equations,  and  contains  guidance  on  the  choice  of  input  parameters. 

The  next  four  subsections  describe  the  input  deck  used  with  PUFF. 
All  the  input  information  is  organized  to  reflect  the  following  guide¬ 
lines  : 

•  Each  card  or  group  of  cards  is  labeled  for  ease  of  identifi¬ 
cation.  For  example,  equation-of-state  data  begin  with  the 
identifier  EQST;  yield  data  begin  with  YIELD. 

•  Each  input  line  is  read  and  then  printed  immediately  in  the 
same  format  (echo  printing)  so  that  the  first  page  of  print¬ 
out  looks  like  the  input  deck. 

•  The  first  column  of  each  card  is  treated  as  an  indicator  to 
control  the  reading  process,  but  it  is  not  data. 

•  The  minimum  amount  of  data  is  used  for  each  problem.  For 
example,  the  required  data  for  a  material  are  contained  on 
just  two  cards.  On  the  first  card  are  indicators  that  show 
whether  more  property  cards  are  required  because  of  special 
models  used  for  the  material. 

GENRAT  has  the  capability  of  performing  several  problems  one  after 
the  other  and  for  reading  material  properties  or  spectral  data  from  a 
data  bank  on  disk,  tape,  or  cards.  The  input  deck  structure  required 
for  using  these  capabilities  is  described  in  the  following  subsection 
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and  shown  in  sample  decks  in  Appendix  C.  The  initialization  operations 
require  the  subroutines  GENRAT,  DEPOS,  SCATTO,  REDR,  HDATA,  and  EXTRA. 

The  following  subsections  describe  four  sets  of  data  cards  that  may  be 
used  for  each  problem:  general  running  data,  materials  data,  cell  layout, 
and  radiation  data.  The  first  three  sets  are  required  for  every  problem, 
but  the  fourth  is  needed  only  for  radiation  problems. 

5 . 1  Input  of  General  Running  Information 

The  first  group  of  data  identifies  the  computation  and  contains 
indicators  controlling  the  length  of  the  computation,  the  amount  of 
printing,  the  number  of  materials  and  the  type  of  computation. 

The  first  or  title  card  contains  a  brief  title  for  the  run.  This 
line  of  information  (plus  the  date)  serves  as  a  heading  for  each  page 
of  all  major  prints  from  the  GENRAT,  SCRIBE,  and  EDIT  subroutines.  The 
first  character  of  this  card  serves  as  an  indicator: 

Blank  -  normal  input  continues. 

D  -  Deposition  layout  only;  the  next  required  input  card  is 

the  NMTRLS  card. 

T  -  The  remainder  of  the  general  running  data  should  be  read 
from  tape.  On  the  tape  these  data  records  follow  a  title 
record  containing  the  last  10  characters  of  the  title  card 
(See  Appendix  C) . 

X  -  Same  as  "Tn,  but  in  addition,  data  will  be  read  in  through 
the  EXTRA  routine  following  the  NMTRLS  card. 

When  the  first  character  is  blank,  any  number  of  comment  cards  may 
follow  this  first  card  if  these  cards  contain  a  nonblank  first  column. 

The  second  normal  input  (NTEDT)  card  contains  some  of  the  print 
controls  (NTEDT  and  NJEDIT) ,  the  rezoning  control  (NREZON) ,  and  the 
geometry  designator  (NALPHA) .  NTEDT  is  the  number  of  EDITs  (print  of 
condition  of  the  coordinate  array  at  a  specified  time)  to  be  called, 
and  NJEDIT  is  the  number  of  lines  containing  coordinate  locations  (JEDITS) 
for  which  a  stress  history  is  to  be  printed.  If  NTEDT  is  nonzero,  the 
next  cards  contain  a  list  of  the  TEDITs  or  times  at  which  the  prints 
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will  occur.  If  NJEDIT  is  nonzero,  the  following  NJEDIT  lines  contain  a 
list  of  indicators  of  the  variables  and  J  values  of  cells  for  which 
historical  listings  are  needed:  the  format  for  these  lines  is  described 
in  Appendix  C  under  Historical  Prints.  NREZON  controls  rezoning,  i.e., 
resizing  of  cells  and  recomputation  of  associated  coordinate  and  cell 
quantities  at  intervals  during  the  computation.  The  type  of  rezoning 
depends  on  the  sign  of  NREZON: 

•  A  positive  NREZON  is  the  number  of  rezones  desired,  and  two 
additional  input  cards  containing  lists  of  NTR  and  JREZON 
are  required.  NTR  is  the  number  of  the  TEDIT  (hence  the 
time  at  which  each  rezone  is  called) ;  JREZON  is  the  right¬ 
most  coordinate  in  each  rezone. 

•  If  NREZON  is  negative,  an  input  card  containing  DTMAX, 

TREZON,  NARZ,  and  TARZ  is  required.  DTMAX  is  the  desired 
size  of  the  time  step  DTNH  and  TREZON  is  the  time  interval 
between  rezones.  Rezoning  is  terminated  if  the  number 

of  rezones  exceeds  NARZ  or  the  time  exceeds  TARZ.  If  NARZ 
and  TARZ  are  zero,  then  rezoning  continues  at  intervals  of 
TREZON  until  DTNH  exceeds  DTMAX.  If  DTMAX  is  negative  on 
the  input  card,  it  is  interpreted  as  the  number  of  cells 
desired  in  the  material  whose  layer  number  is  L  =  -  NREZON. 

From  this  input  value,  DTMAX  (in  its  usual  significance)  is 
computed  in  GENRAT. 

The  geometry  designation  NALPHA  has  the  meaning: 

0  or  1  Planar  grid 

2  Cylindrical  layout  with  X  =  0  at  axis  of  cylinder 

3  Spherical  layout  with  X  =  0  at  center  of  sphere. 

The  subroutine  REZONE  can  only  increase  the  size  of  cells;  there¬ 
fore,  cells  should  be  laid  out  as  small  as  desired  initially.  In  REZONE 
it  is  presumed  that  the  cell  at  JREZON  (an  input  quantity  for  NREZON 
>  0  or  a  cell  selected  by  REZONE  for  NREZON  <  0)  is  of  proper  size, 
then  all  cells  with  smaller  J  values  are  resized  to  about  the  same 
thickness . 

In  a  radiation  deposition  computation,  small  cells  are  needed  at 
early  times  near  the  front  surface  to  properly  model  the  deposition, 
expansion,  and  spallation  that  occur  in  that  region.  After  the  deposi¬ 
tion  is  complete,  there  is  less  need  for  the  very  small  cells  near  the 
front.  A  reasonable  approach  to  handling  these  requirements  is  to  lay 
out  the  coordinates  initially  with  a  geometric  size  variation  starting 
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with  10  to  10  cm  cells  at  the  front  and  possible  increasing  to  0.1 
cm  at  the  rear.  Following  deposition,  the  cells  may  be  increased  in 
size  by  rezoning.  Because  of  the  averaging  operations  that  occur  in 
REZONE,  there  is  a  loss  of  kinetic  energy  and  some  smoothing  of  the 
stress  wave;  therefore,  rezoning  should  not  be  used  excessively  and  cell 
sizes  should  not  be  more  than  doubled  at  each  rezone. 

For  impact  problems,  a  different  procedure  should  be  followed  for 
rezoning  and  initial  layout.  To  properly  represent  the  stress  history 
in  the  impact  of  a  thin  flyer  on  a  target,  10  to  20  cells  should  be  used 
in  the  flyer  and  similar  sized  cells  should  be  used  in  the  target  at  the 
impact  point.  Larger  cells  can  be  used  deeper  into  the  target.  The 
appropriate  time  for  rezoning  is  following  the  completion  of  the  impact 
(twice  the  propagation  time  through  the  flyer).  Usually  one  rezoning 
is  sufficient  to  establish  a  suitable  cell  size  for  the  balance  of  the 
computation. 

Following  the  NTEDT  card  and  the  cards  containing  TEDITs,  JEDITs, 
and  rezoning  controls  is  a  card  containing  NEDIT  and  three  termination 
criteria.  NEDIT  is  the  number  of  cycles  between  calls  to  EDIT.  These 
EDIT  calls  are  independent  of  those  provided  by  the  TEDIT  array;  hence 
this  is  a  second  procedure  for  requesting  an  EDIT  printout.  The  param¬ 
eters  that  are  used  to  stop  the  running  of  the  problem  are  JCYCS,  the 
number  of  major  cycles  or  calls  to  the  HYDRO  subroutine  that  can  be 
made  before  the  program  stops;  CKS ,  the  depth  into  the  material  beyond 
which  the  maximum  stress  should  not  move;  and  TS,  the  stop  time.  The 
calculation  halts  when  any  of  these  three  is  reached. 

The  last  required  data  card  in  this  group  contains  NMTRLS ,  the 
number  of  materials;  MATFL,  the  number  of  the  last  layer  of  the  flyer 
plate  (neglect  gaps  in  counting  these  layers);  UZERO,  the  velocity 
of  the  flyer  plate,  and  NSCRB,  a  set  of  10  flags  indicating  whether 
plotting  is  called  for  from  DEPOS.  For  problems  other  than  impacts. 
MATFL  acts  as  an  indicator  for  the  type  of  problem: 

•  Explosive  detonation:  set  MATFL  =  1,  UZERO  =  0.  The 
problem  is  initiated  by  the  energy  insertion  procedure 
in  EXPLODE. 
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•  Radiation  deposition:  set  MATFL  =  0.  Then  DEPOS  is  called 
to  provide  the  energy  deposition. 

•  Mirror  impact:  set  MATFL  =  -  1  for  a  symmetric  impact. 

•  Pressure  boundary  at  J  =  1:  set  MATFL  =  -  2  and  provide  a 
pressure  history  in  FUNCTION  SIGMAT  (1,  TIME)  or  read  in 
P6(l)  and  T6(l)  through  the  EXTRA  routine  following  the 
normal  data  deck.  The  applied  pressure  has  the  form 

P=  P6(l)  exp (TIME/ T6 ( 1) ) . 

•  Pressure  boundary  at  J  =  JFIN:  set  MATFL  =  -  3  and  provide 
a  pressure  history  in  SIGMAT(2,  TIME)  or  read  in  P6(2)  and 
T6(2)  as  for  pressure  at  J  =  1. 

The  plotting  called  for  by  the  flags  NSCRB(l)  to  NSCRB(3)  occurs 
at  the  end  of  the  layout  and  is  controlled  by  DEPOS.  The  three  flags 
pertain  to  plots  of  energy,  pressure,  and  temperature,  respectively,  as 
functions  of  distance  into  the  target.  If  one  or  more  of  these  flags 
are  nonzero,  then  x  and  y  ranges  for  each  plot  are  read  in. 


5 . 2  Input  of  Material  Properties 

Following  the  general  running  information  are  several  sets  of  cards, 
one  set  for  each  material.  The  material  properties  information  is  grouped 
in  the  following  categories: 

•  Material  name,  solid  density,  and  a  set  of  flags — NCMP,  NFR, 

NPOR,  NDS ,  NPR,  NYAM,  and  NCON — which  control  the  reading  of 
additional  data,  plus  NVAR,  which  controls  the  number  of 
extra  variables  per  cell  available  for  the  material  (See 
Appendix  C  for  NVAR).  In  the  input  listings  in  Appendix  C, 
the  first  6  indicators  are  labelled  with  the  contracted  titles 
CFP  and  DPY . 

•  Solid  equation-of -state  parameters:  EQSTC,  EQSTD,  EQSTE, 

EQSTG,  EQSTH,  and  EQSTS.  EQSTC,  EQSTD,  and  EQSTS  are  the 
parameters  of  the  Hugoniot  pressure  function.  The  C,D,S 
form  Eq.  (4.6),  the  linear  shock  velocity  relation  or 
Murnaghan  equation  can  be  represented;  EQSTS  indicates  which 
form  is  used.  The  three  parameters  have  the  following  mean¬ 
ings  : 


C,  D,  S  form  Murnaghan 


Linear  II 


U 


s 


EQSTC 


C 


a/b 


C 


L 


EQSTD 


D 


b 


S 


L 


EQSTS 


S 


1.0 


2.0 
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The  parameters  EQSTG  and  EQSTH  are  the  Griineisen  ratios  T 
and  H.  EQSTE  is  the  sublimation  energy. 

•  Special  data  required  for  composite  (NCMP) ,  fracture  (NFR) , 
porous  (NPOR) ,  deviator  stress  (NDS) ,  or  pressure  (NPR) 
models.  Some  of  these  are  read  in  GENRAT,  and  some  in  the 
subroutine  containing  each  model.  See  Nomenclature  for 
meaning  of  each  indicator. 

•  Optional  material  properties.  TENS,  spall  strength  values 
(Section  4.3);  COSQ  or  VISC,  artificial  viscosity  coefficients 
(Section  3.3);  YIELD,  yield  strength  and  shear  modulus  (Sec¬ 
tion  4  and  Appendix  G) ;  and  EMELT,  or  MELT,  GMELT ,  thermal 
strength  reduction  parameters  (Appendix  D) .  The  number  of 
these  optional  lines  is  NYAM. 

•  Radiation  absorption  data  (NCON) .  NCON  is  the  number  of 
constituents  of  a  material  for  which  radiation  absorption 
data  are  provided;  hence  mixtures,  alloys,  and  composites 
are  accounted  for  (Section  5.4  and  Appendix  A). 

Of  this  imposing  array,  only  the  first  and  second  lines  are  required. 
The  flags  that  are  read  in  on  the  first  card  indicate  which,  if  any,  of 
the  other  data  items  are  supplied.  The  data  under  the  control  of  NYAM 
are  all  given  nominal  values  by  GENRAT:  these  nominal  values  are  used 
unless  they  are  over-written  by  data  from  input.  The  spall  strength 
within  materials  is  initialized  high  to  avoid  spall,  the  spall  strength 
between  layers  is  low  to  permit  separation,  the  yield  strength  is  zero, 
quadratic  and  linear  artificial  viscosity  coefficents  are  4.0  and  0.15, 
respectively,  and  the  thermal  strength  reduction  function  is  set  to 
degrade  the  strength  gradually  and  permit  melting  at  one-tenth  the 
sublimation  energy  (EQSTE) . 

The  material  data  in  all  the  above  categories  may  be  provided  either 
from  a  data  bank  or  as  part  of  the  input  deck.  Details  of  the  data  deck 
setup  for  these  two  alternatives  are  given  in  Appendix  C.  If  a  data 
bank  is  used,  it  contains  a  series  of  card  images  corresponding  exactly 
to  those  that  would  appear  in  a  material  properties  deck.  To  indicate 
that  a  data  bank  is  being  used  for  the  material  data,  one  card  is  inserted 
containing  a  nonblank  first  column  and  the  material  name.  Examples  of 
such  data  decks  are  shown  in  Appendix  C.  The  use  of  a  data  bank  is 
especially  convenient  for  multiple  runs  with  an  identical  set  of  mate¬ 
rials  . 
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5 . 3  Layers  and  Cell  Layout 

The  materials  in  the  problem  are  laid  out  in  a  series  of  layers, 
and  each  layer  is  discretized  into  a  number  of  finite  difference  cells. 
The  total  number  of  layers,  including  any  empty  layers  or  gaps,  is  given 
as  NLAYER.  The  array  JMAT  then  provides  the  relationship  between  layers 
and  materials.  For  example,  for  layer  L,  JMAT(L)  is  M,  the  material 
number.  For  an  empty  layer,  JMAT(L)  is  zero.  No  finite  difference  cells 
or  coordinates  are  used  to  represent  gaps;  adjacent  layers  of  material 
are  merely  separated  by  the  gap  distance.  Following  the  cell  layout, 
NLAYER  is  reduced  by  GENRAT  to  the  number  of  layers  containing  material. 

The  materials  in  each  layer  are  laid  out  in  a  Lagrangian  grid 
(Lagrangian  because  the  grid  moves  with  the  material),  with  variable 
spacing  between  the  grid  points.  This  variability  allows  for  flexibility 
in  planning  the  layout  of  the  grid,  for  concentrating  small  cells  near 
regions  of  interest,  and  for  using  large  cells  elsewhere.  For  best 
results  in  the  computations,  the  cell  sizes  should  be  allowed  to  vary 
slowly.  Each  material  is  divided  into  one  or  more  zones;  within  each 
zone  the  cell  sizes  are  uniform  or  they  vary  in  either  an  arithmetic  or 
geometric  progression.  The  numbering  of  cells  and  coordinates  is  shown 
in  Figure  5.1.  Each  cell  has  the  same  number  as  the  coordinate  to  the 
left.  Energy  (EHL) ,  mass  (ZHL) ,  density  (DHL),  pressure  (PHL) ,  and 
stress  (SHL)  are  the  basic  quantities  associated  with  the  cells  or  mid¬ 
cell  points.  The  coordinate  location  (X)  and  velocity  (U)  refer  to 
coordinate  points.  Figure  5.2  shows  a  possible  variation  of  cell  sizes 
(five  different  zones  of  varying  sizes  are  possible  for  each  layer; 
zones  of  geometric  and  arithmetic  cell  variations  may  be  intermixed) . 

The  numbering  system  that  is  used  for  the  grids  is  also  shown  in  Figure 
5.2;  two  coordinate  numbers  are  assigned  to  interfaces  between  materials. 
The  last  coordinate  point  in  each  layer  is  called  JBND(NL)  where  NL  is 
the  layer  number.  The  last  coordinate  used  is  JFIN,  which  is  one  greater 
than  the  last  JBND  value;  this  definition  of  JFIN  is  useful  for  the 
operations  in  HYDRO. 

The  zoning  input  data  are  provided  on  a  series  of  cards,  one  for 
each  zone  of  each  layer.  The  first  card  of  the  zoning  set  gives  the 
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number  of  layers  (NLAYER)  and  the  array  ( JMAT) ,  which  tells  which  material 
is  in  each  layer  of  the  layout.  On  the  first  card  for  each  layer  is 
the  number  of  zones,  NZONES ;  the  number  of  cells  in  the  first  zone, 

NCELLS ;  the  zone  thickness,  TH;  the  size  of  the  first  cell,  DELX;  and 
the  size  of  the  last  cell  of  the  zone  in  an  arithmetic  progression, 

DELFIN.  For  a  geometric  progression,  DELFIN  is  interpreted  as  the  RATIO 
between  sizes  of  successive  cells,  and  DELX  is  disregarded.  For  uniform 
cell  sizes,  DELX  and  DELFIN  are  omitted.  For  an  arithmetic  layout, 
either  DELX  or  DELFIN  is  specified.  A  geometric  layout  is  indicated 
by  values  for  both  DELX  and  DELFIN,  although  the  actual  value  of  DELX 
is  disregarded.  Examples  of  the  cards  appear  in  Appendix  C. 

The  following  analyses  of  the  zoning  are  made  to  give  the  bases 
for  the  computer  calculation  and  also  to  present  formulas  for  the 
incremental  thickness  change  between  cells  and  for  thicknesses  of  the 
first  and  last  cells.  It  is  often  desirable  to  compute  the  increment 
and  cell  sizes  before  a  propagation  calculation  to  guarantee  proper 
matching  between  cell  sizes  in  different  zones  and  ensure  that  the 
change  in  cell  size  is  not  too  great  within  a  zone.  For  the  analysis  of 
an  arithmetic  progression,  the  thickness  of  a  zone  T^  is  first  represented 

as  a  sum  of  the  cell  thickness  AX. 

1 

T,  =  EAX.  «  AX-  +  (AX  +  6)  4-  (AX  +  26)  +  [AX,  +  (N  -  1)6]  (5.1) 

hill  1  1  c 

where  AX^  =  DELX  is  the  thickness  of  the  first  cell,  6  is  the  incremental 
change  in  thickness  from  one  cell  to  the  next,  and  N^  is  the  number  of 
cells  in  the  zone.  Using  the  formula  for  the  sum  of  an  arithmetic 
series  Eq.  (5.1)  is  changed  to  the  following  form: 

T  =  N  AX  +  6 (N  -  1)N  / 2  (5.2) 

h  cl  c  c 

Equation  (5.2)  can  then  be  rearranged  to  obtain  the  equation  for  the 
incremental  change  in  cell  thickness,  6 

6  -  2  (T,  /N  -  AX  )/(N  -  1)  (5.3) 

n  c  I  c 
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According  to  Eq.  (5.1),  the  expression  for  the  thickness  of  the  last 
cell,  AX^  =  DELFIN,  is  the  following 

AXf  =  AX^  +  (N  -  1)6  (5.4) 

Then  Eq.  (5.2)  can  be  altered  to  give  the  form 


Th  =  Nc(AXl  +  AXf)/2  (5‘5) 

Equation  (5.5)  can  then  be  rearranged  to  provide  expressions  for  evaluat¬ 
ing  the  thickness  of  either  the  last  cell  in  the  zone,  given  the  thick¬ 
ness  of  the  first,  or  vice  versa 


AX-  =  2T  /N  -  AX  (5.6) 

r  h  c  1 

AX  =  2T  /N  -  AX  (5.7) 

1  he  r 


When  an  arithmetic  progression  zoning  is  desired,  either  AX^  or 
AX^  may  be  entered.  For  a  uniform  distribution  of  cell  sizes,  both 
AX^  and  AX ^  should  be  left  at  zero. 

For  the  geometric  progression  the  input  quantity  DELFIN  is  inter¬ 
preted  as  R  ,  the  ratio  between  successive  cell  sizes.  The  first  cell 
has  the  thickness  DELX  =  AX^,  and  t^ie  last  cell  thickness  is 


AX  =  AX  R  (Nc  "  1) 
f  lx 


(5.8) 


The  thickness  of  the  zone  is  given  by  the  usual  sum  of  a  geometric 
progression. 


N 


il  -  R 


Th  =  AX1  TT 


(5.9) 


X 


The  geometric  cell  layout  is  actually  overspecified  by  the  input.  There¬ 
fore  the  input  value  of  AX^  is  disregarded  and  AX^  is  computed  from  Eq. 
(5.9)  and  the  given  values  of  T^,  R  ,  and  Nq.  The  nonzero  value  of 
AX^  in  the  input  merely  indicates  a  geometric  layout.  The  geometric 
progression  is  particularly  useful  in  radiation  deposition  problems 
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cm  at 


in  which  it  may  be  necessary  to  vary  cell  thicknesses  from  10 
the  surface  to  10  ^  cm  deep  inside  the  material. 

Correct  sizing  of  the  cells  can  be  very  important  in  getting  useful 
results  from  a  computation.  No  complete  theory  is  available  for  optimiz¬ 
ing  cell  sizes,  but  the  following  guide  lines  have  been  obtained: 

•  Small  cells  should  be  used  at  the  surface  of  deposition  in 
a  radiation  deposition  problem.  The  cells  should  be  small 
enough  that  no  more  than  1%  of  the  energy  is  absorbed  in 
the  first  cell.  If  vaporization  occurs,  several  vaporizing 
cells  should  be  provided. 

•  In  an  impact  problem  the  cells  on  either  side  of  the  inter¬ 
face  should  be  matched  in  such  a  way  that  the  interface 
particle  velocity  computed  on  the  first  cycle  is  approxi¬ 
mately  equal  to  the  final  steady-state  value.  This  sizing 
can  be  accomplished  adequately  if  the  cells  are  sized  so 
that  the  times  to  traverse  them  are  about  equal;  i.e., 
materials  with  low  velocities  should  have  smaller  cells. 

The  correct  interface  velocity  need  not  be  obtained  on  the 
first  cycle,  as  the  program  will  iterate  to  the  correct 
value  in  a  few  cycles  if  the  artificial  viscosity  coeffi¬ 
cients  have  normal  values.  Large  amounts  of  viscosity  will 
slow  the  convergence  of  the  iterations.  It  does  not  appear 
necessary  to  match  cell  sizes  precisely  across  an  interface, 
even  the  impact  interface.  A  series  of  computations  was 
made  with  an  impact  of  C-7  epoxy  (p  =  1.19)  and  tungsten 

(p  =  19.3).  The  "equal  time"  criterion  above  dictated  that 
C-7  cells  should  be  5/8  as  large  as  tungsten  cells.  Compu¬ 
tations  were  made  with  C-7  cells  1/4,  5/8,  1.0,  and  2.5 
times  as  large  as  the  tungsten  cells.  Even  the  most  mis¬ 
matched  cases  gave  an  initial  overstress  only  8%  higher 
than  the  best  matched  case. 

•  For  porous  materials  that  are  compacted  during  the  computa¬ 
tions,  a  large  number  of  cells  should  be  used  to  represent 
the  material.  This  number  is  required  to  provide  adequate 
definition  of  the  material  response  during  the  compacting 
process.  Generally,  a  half-consolidated  cell  is  not  a 
good  average  of  an  uncompacted  cell  and  a  solid  cell. 

•  Rise  times  of  stress  waves  are  equal  to  several  traverse 
times  for  the  cells.  Hence,  the  definition  of  the  stress 
history  can  be  used  as  a  basis  for  defining  acceptable 
cell  sizes. 

•  Cell  sizes  can  be  varied  gradually  (less  than  5%  per  cell) 
so  that  the  cells  are  small  and  stress  waves  are  sharply 
defined  in  regions  of  interest  and  large  at  other  points 

in  the  flow.  The  material  boundaries  need  be  extended  only 
far  enough  from  the  region  of  interest  that  no  disturbing 
wave  from  the  boundary  reaches  the  region  of  interest 
during  the  problem  time. 


66 


5.4  Thermal  Energy  Deposition 


Thermal  energy  is  deposited  into  the  cells  to  simulate  radiation 
from  x-ray,  electron  beam,  or  laser  sources.  The  energy  is  deposited 
into  the  cells  at  a  constant  rate  during  the  shine  time  of  the  source. 

This  section  outlines  the  deposition  options  and  required  input.  Appendix 
A  contains  more  information  about  the  energy  deposition  process.  Initial¬ 
ization  of  deposition  is  handled  in  the  subroutine  DEPOS. 

In  SRI  PUFF,  several  radiation  sources  may  be  used  at  once,  each 
with  its  own  spectrum  and  shine  time.  The  sources  may  radiate  at  normal 
incidence  onto  the  material  layers  (planar  geometry  is  assumed)  or  at 
oblique  angles.  Each  layer  may  have  a  different  angle  to  treat  radiation 
through  several  separate  layers  at  different  inclinations. 


5.4.1  Deposition  Types 

Three  deposition  procedures  are  available  for  representing  radia¬ 
tion  from  each  source. 

•  Black  body  x-ray  source.  The  radiation  source  is  represented 
as  a  series  of  black  bodies.  The  required  data  are  energy 
reaching  the  surface  (cal/cm^),  temperature  of  each  black 
body  (keV) ,  and  absorption  coefficients  for  each  material. 

•  Arbitrary  x-ray  spectrum.  The  radiation  source  is  repre¬ 
sented  by  a  table  of  energies  in  calories/cm^  versus  hv 
(photon  energy  or  temperature,  in  keV)  for  each  spectrum. 
Absorption  coefficients  for  each  material  are  required. 

•  A  depth-dose  profile  in  the  form  of  a  table  of  deposited 
energies  (calories/g)  versus  depth  (cm).  This  option 
permits  use  of  x-ray  deposition  profiles  from  a  code  that 
treats  scattering,  fluorescence,  and  photoelectric  effect 
or  deposition  from  laser  or  electron  beam  sources.  No 
absorption  data  are  required  with  this  option. 

With  the  black  body  option,  DEPOS  constructs  a  spectrum  consisting  of 
95  energy  values  at  specific  hv  (photon  energy)  points.  Then  the  radiant 
energy  that  will  be  deposited  in  each  finite  difference  cell  is  computed 
and  stored  in  the  SS  array.  The  photoelectric  absorption  coefficients 
are  used  for  the  deposition  calculation.  Because  absorption  by  Compton 
scattering  and  fluorescence  is  neglected,  the  DEPOS  deposition  calcula¬ 
tion  should  not  be  relied  on  for  black  body  temperatures  greater  than 
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a  few  keV.  DEPOS  treats  the  arbitrary  spectrum  the  same  as  the  black 
body  spectrum  for  deposition  calculations. 

For  the  third  deposition  option,  the  depth-dose  profile  is  used  to 
calculate  the  radiant  energy  to  be  deposited  in  each  finite  difference 
cell.  The  energy  for  each  cell  is  calculated  (in  SCATTO)  by  passing 
an  interpolation  function  through  sets  of  points  in  the  profile  and 
integrating  the  area  under  the  function  between  the  limits  of  the  cell 
dimension. 

5.4.2  Data  Required 

Three  types  of  data  are  read  into  DEPOS  for  deposition  calculations: 
photoelectric  absorption  data,  spectra  or  black  body  temperatures,  and 
depth-dose  profiles.  The  absorption  coefficient  for  x  rays  has  the  form 
shown  in  Figure  5.3.  In  a  log-log  plot  there  are  sharp  discontinuities 
at  hv  values  corresponding  to  the  electron  energy  levels  or  edges.  Be¬ 
tween  these  edges  the  absorption  function  is  usually  fairly  linear.  The 
following  function  is  used  to  fit  the  absorption  data  between  edges: 

In  a  =  A  +  A  w  +  A  w^  +  AQw^  (5.10) 

a  0  1  2  3 

where  a  =  mass  absorption  coefficient  (barns/atom) 

cl 

w  =  ln(hv) ,  with  hv  in  keV 

Aq  ...  A^  =  coefficients  of  the  fit. 

The  required  data  are  the  atomic  weight,  number  of  edges,  and  values  of 
the  edges  and  Afs  for  each  interval  between  edges.  Samples  of  the 
absorption  data  input  are  given  in  Appendix  C. 

The  deposition  data  for  any  radiation  problem  include  the  number 
of  spectra  or  sources  (NSPEC) ,  angles  (ANGLE)  between  the  shine  direction 
and  normal  incidence,  type  of  deposition,  fluence  (ECAL) ,  and  shine  dura¬ 
tion  (SSTOP-START) .  For  black  body  spectra,  one  line  containing  the 
temperature  (TEMP)  and  fluence  (ECAL)  is  required  for  each  black  body. 
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FIGURE  5.3  TYPICAL  VARIATION  OF  PHOTOELECTRIC  MASS  ABSORPTION 
COEFFICIENT  WITH  PHOTON  ENERGY 
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For  an  arbitrary  spectrum,  the  additional  data  are  the  number  of  hv 
values  (NHNU ,  not  more  than  109),  the  format  for  reading  the  table  of 
data,  and  NHNU  pairs  of  hv  (TBL)  and  energy  (El)  values. 

The  data  for  a  depth-dose  profile  are  the  number  of  pairs  of  points 
(NPOINT) ,  the  format  for  reading  the  profile  data,  and  the  pairs  of 
depth  (TBL)  and  dose  (El)  values.  Samples  of  all  these  radiation  options 
are  given  in  Appendix  C. 

5.4.3  Special  Features 

Many  special  features  are  often  required  for  handling  radiation 
problems:  the  available  options  are  mentioned  here. 

Angles .  If  the  layers  are  positioned  at  different  inclinations, 
several  values  of  ANGLE  are  required.  The  multiple  angles  require  that 
positions  21  to  27  of  the  NSPEC  line  contain  "ANGLES . "  Otherwise,  all 
layers  are  assumed  to  have  the  inclination  ANGLE (1) . 

Impulse.  The  impulse  calculated  by  the  McCloskey-Thompson  formula 
is  computed  at  each  coordinate  point.  The  impulse  at  point  J  is 


where  E  =  the  deposited  energy  at  a  point 

E^  =  the  melt  energy 

Z  =  the  mass  per  unit  area 

2 

I  =  impulse  in  dyn-sec/cm  . 

Multiple  Sources.  The  present  arrays  are  dimensioned  for  five 
sources.  If  more  are  required,  SSTOP  and  START  in  the  COMMON  labeled 
/RAD/  should  be  redimensioned.  The  SS  array  may  also  require  more  storage. 
The  SS  array  in  labeled  C0MM0N/SS/  should  have  a  dimension  at  least  as 
large  as  the  number  of  sources  times  the  number  of  coordinates. 

Source  Type  Indicator.  The  source  type  indicator  A1  is  on  the 
spectrum  name  line  following  the  NSPEC  line.  A1  fills  the  5  spaces 
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from  columns  11  to  15  and  contains  "NARB",  "NBB” ,  or  "NHNU"  for  depth- 
dose  input,  black  body,  or  arbitrary  spectrum,  respectively. 

Normalization  of  the  Depth-Dose  Profile.  The  depth-dose  profile 
may  be  modified  to  permit  changes  in  material  density  and  in  the  fluence. 
For  a  porous  material,  the  depth-dose  profile  is  modified  by  changes  in 
density  only  in  proportion  to  the  ratio  of  densities.  To  permit  a  density 
change,  NARB  is  set  less  than  zero  on  the  line  following  the  NSPEC  line, 
and  an  additional  line  containing  RHOOLD  (the  density  associated  with  the 
depth-dose  profile)  is  inserted.  Then  the  profile  is  automatically 
adjusted  for  the  new  density. 

The  input  depths  in  the  depth-dose  profile  need  not  correspond  to 
the  x-values  in  the  coordinate  array  because  the  depths  will  all  be 
adjusted  to  match  the  first  coordinate  of  each  layer. 

The  depth-dose  profile  is  usually  provided  normalized  to  a  fluence 

2 

of  1  cal/cm  .  Then  the  input  variable  ECAL  is  multiplied  times  the  dose 
energies  to  obtain  the  energy  in  the  problem.  If  the  profile  is  not 
normalized,  the  fluence  ECAL  can  be  obtained  by  setting  NARB  to  ±  1 . 

Then  the  profile  is  normalized  before  applying  the  factor  ECAL. 

5 . 5  Initialization  of  Arrays  and  Indicators 

The  input  data  are  used  to  initialize  the  cell  and  coordinate  arrays 
and  various  indicators.  Included  in  this  initialization  are  yield  and 
work-hardening  factors,  sound  speed,  the  H  indicator  array,  the  NEM,  NET 
and  LVAR  arrays,  and  several  scalar  indicators. 

The  standard  deviator  model  treats  a  yield  strength  that  varies  with 
work-hardening  and  Coulomb  friction  as  follows: 

y  =  yi  +  yd  Ap  +  6  P  =  TOL  4-  YADD (M) • Ap  +  EXMAT(M,1)-P  (5.12) 

where 

Y^  =  the  yield  at  the  previous  time  (YHL) 

Y^  =  a  work-hardening  modulus  (YADD) 
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3  =  a  Coulomb  friction  factor  (EXMAT) 

P  =  the  pressure. 

The  input  value  of  the  work-hardening  modulus,  YADD ,  has  the  strange 
formulation  inherited  from  PUFF  66,  where  the  increase  in  yield  strength 
is 


AY 


p2  -  px 


p  (0.2  -  C  ) 

o  EL 


YADD 


(5.13) 


where 

Pq,  and  =  the  initial  density  and  the  densities  before 
and  after  a  time  increment 

£  =  strain  to  the  Hugoniot  elastic  limit  =  Y  / (2G) 

EL  o 

Y  =  input  yield  strength  =  YOS  in  the  code 
o 

G  =  shear  modulus  =  MU(M). 

To  put  this  work-hardening  relation  into  the  form  of  Eq .  (5.12),  the 
modulus  Y^  is  defined  as 

=  _ YADD  (M) _ 

YD  RHOS (M) *[0.2  -  0.5  *  YOS/MU (M) ]  (5.14) 

In  GENRAT,  YADD (M)  is  reset  to  Y  . 

The  value  of  3  is  derived  by  examining  the  usual  form  of  the  Coulomb 
law  (actually  Coulomb-without-dilatation,  a  special  form  that  permits 
no  plastic  volume  change) : 


T  =  c  +  a  tan  d)  (5.15) 

c  N 

where 

T  =  the  shear  stress  at  yield 
c 

c  =  the  cohesion 

a =  the  normal  stress  on  the  yielding  surface 
(j)  =  the  angle  of  internal  friction. 
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As  shown  in  Section  4,  this  Coulomb  law  can  be  rewritten  into  the  follow¬ 
ing  form 


Y  3°A 
-  i  +  yz 


+ 


1.5  (N,  -  1)P 

_ _ i 

1  +  n,/2 

4> 


(5.16) 


? 

where  =  tan  (tt/4  +  <f)/2) .  Now  Eq .  (5.16)  has  the  form  of  Eq.  (5.12); 
we  only  need  to  determine  the  required  constants  from  the  input  data. 
During  input,  YOS  is  read  in  with  the  valve  2c  and  EXMAT (M,l)  is  read 
in  as  tancj).  Then  YO  and  EXMAT  are  reset  in  GENRAT  as  follows: 


Y0(M)  = 


1  +  N , 

<P 
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(5.17) 


EXMAT (M,l) 


X-5  %  - 


1  +  Na/2 

<(> 


(5.18) 


The  sound  speed,  CHL,  is  initialized  in  GENRAT  according  to  the 
following  rules: 


CHL 


Vbulk  modulus  +  4/3  (shear  modulus) 
density 


for  normal  solids 


detonation  velocity  for  explosives 


(5.19) 


=  EXMAT (M, 3)  for  porous  materials. 

Here  the  value  of  EXMAT (M, 3)  is  calculated  in  the  porous  subroutine — 
POREQST,  PORHOLT,  PEST  or  CAPl — during  its  initialization  and  passed 
back  to  GENRAT. 

For  explosives  that  are  to  undergo  either  a  running  detonation  or 
constant  volume  explosion,  GENRAT  calls  EXPLODE  to  insert  the  chemical 
energy  in  the  EHL  array  and  initialize  NEM  to  the  fraction  detonated. 

For  some  deviator  models  the  NEM  array  is  given  special  initial 
values  as  follows: 

Band  model:  NEM  =  TSR(M,21) 

Gilman  model:  NEM  =  TSR(M,19) 


Bauschinger  model:  NEM  =  yield  strength. 
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For  the  Band  and  Gilman  models,  the  NEM  values  are  the  initial  number  of 
mobile  dislocations. 

The  triple  indicator  array  H  is  set  so  that  H(J,1)  shows  the  solid 
or  porous  state  of  the  material,  H(J,2)  shows  boundary  conditions,  and 
H(J,3)  shows  the  path  taken  by  the  deviator  stress.  The  boundary  indica¬ 
tor  has  the  meanings: 

H(J,2)  =  N,  normal  coordinate  inside  a  material 

L,  left  interface  of  a  layer 

R,  right  interface  of  a  layer 

S,  spalled  interface  or  free  surface 

M,  mirror  or  symmetric  boundary 

P,  pressure  history  boundary 

I,  infinite  boundary. 

When  extra  cell  variables  in  the  COM  array  are  required  for  a  mate¬ 
rial  model,  NVAR  is  set  by  the  user  to  the  required  number  of  variables. 

In  GENRAT,  NVAR  is  used  to  divide  the  COM  array  as  described  in  Appendix 
C.  The  starting  location  in  the  COM  array  for  variables  of  the  Jth  cell 
is  LVAR(J) :  the  LVAR  array  is  initialized  in  GENRAT. 

Several  scalar  indicators  are  also  initialized  in  GENRAT.  In  non¬ 
radiation  problems,  the  factor  SDURM  is  set  to  1.0  to  eliminate  calls 
to  the  deposition  routines.  For  an  impact  problem,  the  particle  velocity 
of  the  flyer  materials  is  set  to  UZERO,  the  flyer  velocity.  For  a 
symmetric  impact,  the  velocity  of  the  first  boundary  (the  impact  inter¬ 
face)  is  set  to  UZERO/2.  The  time-step  variable  DTNH  is  initialized  to 
-12 

10  second  to  begin  the  first  cycle  of  wave  propagation  calculations. 

5 . 6  Initial  Status  Printouts 

The  initial  configuration  for  the  entire  grid  is  printed  out  in 
either  a  deposition  edit  from  DEPOS  or  velocity  edit  from  GENRAT.  Included 
in  the  deposition  edit  are  the  values  of  J,  coordinate  of  each  cell;  DX, 
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the  cell  thickness;  X,  the  coordinate  in  inches  and  centimeters;  four 

variables  indicating  the  energy  in  the  cells;  the  cell  temperature  in 

degrees  centigrade;  pressure  from  an  instantaneous  deposition;  impulse 

from  the  McCloskey-Thompson  integral;  the  material  name,  MATL;  and  the 

condition  variables,  H.  The  energy  quantities  are  the  deposited  energy 

2 

in  erg/g  and  cal/g,  the  cumulative  amount  of  energy  absorbed  in  cal/cm  , 
and  the  fraction  transmitted  through  each  coordinate  plane. 

The  velocity  edit  lists  J,  DX,  X,  U  (particle  velocity),  yield 
strength,  sound  speed,  density,  spall  strength,  mass,  internal  energy 
and  the  H  indicators.  A  sample  edit  listing  is  given  in  Figure  5.4. 


75 


DATE  >  78/08/17.  IDEM  44"9-1  DUCTILE  FRACTURE  I HOT  1145  *»L  UNDER  IMPACT  SHOCKFY 


OJ 

m 

4 

if) 

r- 

X 

O' 

O 

OJ 

i^ 

4 

to 

X 

r- 

JD  O' 

© 

i\i 

m 

4 

if) 

X 

h- 

Oj 

O' 

© 

OJ 

*“ 1 

*■* 

i— i 

fV* 

OJ 

OJ 

Oj 

Oj 

rv 

OJ 

rv 

rv 

Oj 

m 

m 

m 

a: 

X 

X 

X 

X 

ai 

x 

a 

X 

X 

X 

a 

X 

a 

X 

(T 

X 

a  x 

a 

X 

a 

a 

a. 

X 

a 

X 

a 

X 

a- 

X 

X 

x 

2 

z 

z 

z 

2 

z 

z 

Z 

z 

-J 

a 

z 

z 

z 

Z 

z 

z  z 

z 

z 

z 

z 

z 

z 

z 

z 

z 

Z 

z 

z 

—i 

in 

if 

x 

X 

If 

Ifi 

tO 

tf. 

if) 

l/l 

IfJ 

t// 

If) 

tf, 

If) 

If) 

tfl 

tfl  tf 

tf) 

lfi 

if) 

X 

a 

to 

X 

<r. 

X 

X 

u 

if) 

to 

i 

I 

i 

n 

J. 

i 

3  3 

3 

3 

3 

3 

3 

± 

3 

3 

3 

J 

i 

1 

3 

-J 

_t 

_! 

_J 

-J 

_J 

_J 

-J 

_J 

-J 

_j 

_J 

_j 

-j 

-J 

_i  _J 

X 

X 

■ 

_ i 

X 

—i 

X 

< 

4 

4 

4 

4 

< 

< 

< 

< 

< 

< 

< 

< 

< 

< 

<» 

< 

<t  < 

« 

< 

<. 

< 

« 

<t 

< 

< 

< 

< 

c 

c 

< 

x 

to 

if* 

X 

to 

to 

to 

to 

to 

to 

to 

to 

iT 

to 

to 

to 

to 

LO  tO 

to 

to 

to 

to 

Li* 

to 

if* 

ifi 

tf* 

X 

X* 

X 

X) 

4 

4 

4 

4 

4 

't 

s4- 

>4 

sf 

>4 

4 

4 

4 

4 

4 

4  4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

- 

- 

- 

— 

— 

— 

— 

- 

H 

— 

- 

- 

- 

- 

- 

— 

- 

- 

— 

~ 

- 

O 

a 

O 

a 

O' 

O' 

o  a 

O' 

O' 

O 

cr 

O' 

a 

a 

a 

a 

o 

a 

cr 

G 

G 

© 

© 

c 

c. 

©  © 

c 

■G 

© 

© 

G 

c 

G 

© 

G 

G 

G 

G 

X 

4 

4 

4 

4 

4 

4 

4  4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

e 

Ll 

Ll 

U 

LL 

Ll 

IL 

X  G 

X 

X 

X 

IL 

LL. 

X 

Li- 

X 

Uj 

LL 

ll 

X 

O 

G 

o 

o 

© 

O 

©  © 

© 

© 

© 

© 

G 

©  © 

o 

o 

© 

© 

c 

is 

X 

X)  X) 

X 

X 

X 

X  X 

X 

X 

X 

X  X 

X 

X 

X 

X 

X  X 

X 

CL 

4 

4 

4 

4 

4 

4 

4  4 

4  4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

c 

© 

c 

W 

G 

G 

G 

G 

G 

G 

G 

SJ 

>4 

4 

4 

4 

4 

4  4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

G 

Oj 

Oj  Oj 

Oj  Oj 

r\j 

Oj  O 

Oj 

Oj 

Oj 

OJ 

Oj 

Oj 

(V 

Oj 

Oj  Oj 

Oj  <V 

Oj  tv 

rv 

Oj  Oj 

Oj  Oj 

Oj  rv 

X 

o 

o 

o 

o 

G 

o 

o 

O 

o 

o 

o 

o 

© 

© 

o 

© 

©  o 

© 

o 

w 

G 

o 

o 

© 

O 

G 

© 

O 

G 

Oj 

1 

I 

1 

I 

1 

i 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1  1 

1 

1 

1 

1 

I 

l 

1 

1 

1 

1 

1 

1 

X 

Uj 

UJ 

Uj 

Ll 

LlJ 

aJ 

Uj 

UJ 

LLI 

LL 

LL 

UJ 

UJ  U 

LlJ 

X 

UJ  lLj 

X 

LLj 

X 

UJ 

X 

Uj 

X 

X 

X 

X 

X 

o  4 

4 

4 

4 

4 

St 

St 

4 

>4 

h- 

r- 

r- 

r- 

r- 

r- 

r-  r- 

r- 

p- 

h~ 

h- 

r- 

r» 

h- 

r-  r- 

r- 

r- 

i 

*— i 

r-H 

»— < 

»— ( 

»-+ 

f—i 

—4 

X 

X 

X 

X 

X 

X 

X'  X 

X 

X 

X 

X 

c 

X 

X 

X 

U. 

X 

X 

X 

X 

r- 

h- 

h- 

r- 

r- 

h- 

r- 

r- 

r- 

r- 

to 

IT.  lO 

Lfi 

to 

it, 

to  X 

to  XI 

if 

to 

to 

to  to 

to 

IT  X  X 

X 

cr 

Gj 

au 

X 

OLi 

X 

X 

X 

X 

G 

X 

X 

X 

X 

X 

X 

X  X 

X 

X 

X 

X 

X 

X 

X 

X  X 

X  X 

X 

© 

_ 

© 

_ 

_ 

«— H 

O 

rv 

r— 1 

, — i 

—1 

»— 

T— 1 

•— * 

i— i 

© 

r—i 

—< 

H 

— < 

1— (  1—4 

—1 

— < 

—* 

— < 

— < 

•—* 

1— 1 

i— i 

. — 1 

© 

X 

♦ 

4 

♦ 

4 

♦ 

♦ 

♦ 

♦ 

4 

4 

4 

4 

4 

4 

♦  4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

o 

x 

LlJ 

uj  u 

Ll 

UJ 

u 

u- 

Ll 

u 

U 

Ll 

Ll 

Uj  U 

u 

X 

X  X 

X 

X 

X 

X 

X 

X 

x 

X 

X 

X 

X 

X 

X 

\ 

o 

O 

G 

G 

G 

o 

o 

G 

G 

G 

o 

G 

G  G 

G 

© 

© 

©  G 

© 

© 

© 

G 

G 

© 

© 

© 

G 

G 

© 

o 

© 

V 

© 

e 

© 

© 

© 

e 

o 

O 

G 

G 

r 

G 

© 

© 

C 

o 

G 

O  C 

o 

G 

c 

G 

G 

o 

G 

o 

© 

G 

© 

G 

o 

>- 

o 

O 

o 

O  O 

G 

G 

o 

G 

O 

G 

© 

O 

© 

© 

© 

O 

O  © 

© 

G 

G 

© 

O 

© 

O 

© 

© 

O 

G 

O 

o 

- 

- 

- 

- 

- 

- 

- 

- 

r—i 

- 

- 

- 

- 

- 

- 

- 

- 

- 

- 

- 

- 

- 

- 

- 

- 

- 

- 

- 

- 

O 

O 

o 

o 

o 

o 

o 

o 

O 

o 

O 

O 

© 

O 

o 

i 

o 

o 

1  1 

o  o 

i 

o 

O 

G 

1 

O 

o 

o 

© 

1 

o 

G 

1 

o 

O 

o 

o 

© 

o 

o 

o  o 

G 

o 

G 

O 

© 

© 

© 

o 

o 

© 

o 

o 

©  o 

© 

© 

© 

o 

© 

© 

O 

© 

© 

© 

G 

o 

© 

r' 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

4 

4 

4 

4 

4 

4 

«  4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

-r 

4 

4 

4 

2 

U 

Ll 

X 

Ll 

Ll 

U 

LL 

Ll 

U_ 

U. 

LL 

LL 

U 

U 

LL 

X 

u 

U  X 

X 

X 

X 

X  Ll 

X 

u_ 

X 

X 

LL 

U 

X 

u 

O 

4 

4 

4 

4 

4 

St 

St 

^4 

-4 

St 

.o 

to 

to 

to 

to 

IT 

lT>  iT 

X  to 

to 

to 

to 

to  to 

X 

X 

X 

X 

if) 

X 

\ 

a 

X 

cc 

a 

X 

a 

a 

CL 

a 

X 

X 

o 

© 

© 

© 

o 

© 

©  G 

©  © 

© 

G 

G 

© 

© 

© 

© 

G 

G 

G 

G 

X 

r- 

r- 

h~ 

r- 

r* 

r- 

r-  r- 

r- 

f" 

r- 

r- 

r~  r- 

r- 

r- 

r-  r- 

r- 

r- 

h- 

r- 

r- 

r- 

r- 

r- 

r- 

h- 

r- 

r- 

OJ 

(V  rv 

(*o  Oj 

o. 

Oj  Oj 

Oc 

Oj 

OJ 

Oj 

rv 

rv. 

Oj 

Oj 

OJ 

Oj  fV, 

rv  rv 

rv  Cv 

(V 

rv  rv 

rv  rv 

IV 

(V 

Oj 

rv 

x 

if  )  if  1 

X 

tf* 

tii 

tO 

ti 

ti< 

tO  til 

tf. 

tii 

to 

ifi 

lO 

XtO 

to  lO 

tO  to 

to 

tO  ul 

U'l 

ti*  x 

XI 

X> 

ti> 

© 

o 

G 

G 

© 

o 

c  > 

G 

o 

© 

o 

w 

© 

G 

© 

© 

o 

o  © 

G 

o 

ZJ 

© 

C/ 

c 

© 

G 

G 

c 

o 

G 

© 

u 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

4 

4 

4 

4 

4 

4 

4  4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

llJ 

UJ 

UJ 

X 

UJ 

UJ 

UJ 

-U 

U  UJ 

LlJ 

Ul 

UJ 

Uj 

UJ  U 

U  X 

X  X 

X 

X 

X 

X  X 

X 

X 

X 

X 

X 

X 

X 

l/l  X 

x 

43 

x 

\L> 

>0 

•L 

X) 

XI 

X 

4 

4 

4 

4 

4- 

4  4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

4 

\ 

•-H 

t-H 

, — i 

w— 

•—4 

, — 1 

i 

r— « 

i— i 

, — ■ 

i 

w—< 

F-H 

H 

_ _ _ 

_ _ _ 

r-H 

r-t 

_ _ _ 

— j 

•-* 

X 

r- 

r- 

© 

r- 

r- 

r- 

r- 

r- 

r- 

r- 

r» 

X 

X 

X 

X 

X  X 

cc  ® 

CC 

X  X 

X 

X 

X 

X 

X  X 

X  X 

X 

X 

• 

o 

X 

X 

x 

s r 

X 

sC 

sC 

>r 

•£ 

o 

X 

X 

X 

X 

X 

X 

X 

X 

X  X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

cr 

O' 

cr 

cr 

O' 

O' 

O' 

cr 

O' 

O' 

Cb 

cr 

O' 

O'  O' 

O'  O' 

O'  O' 

O' 

cr 

O' 

O' 

O' 

O' 

O' 

cr 

O 

cr 

o 

O' 

o 

o 

CV 

o 

© 

G 

G 

G 

c 

O  G 

G 

o 

G 

G 

c 

© 

o 

© 

© 

©  © 

o  o 

o 

© 

c 

c 

© 

o 

© 

© 

G 

G 

G 

u 

X 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

4 

4 

4 

4 

4 

4 

4  4 

4 

4 

4 

4 

•» 

4 

4 

4 

4 

4 

♦ 

4 

4 

X 

u 

UJ 

u. 

X 

llI 

UJ 

LLi 

UJ 

U  uJ  UJ 

LlJ 

UJ 

UJ 

UJ  Ul 

UJ  X 

X  X 

X  X  X 

X  X 

X 

X 

X  X 

X  X 

X  X 

X. 

\ 

© 

o 

o 

o  o 

o 

o 

O 

G 

© 

O 

© 

o 

o 

o 

© 

© 

o  o 

©  o 

© 

o 

© 

© 

o 

© 

© 

© 

o 

© 

© 

Z 

m 

m 

ro 

m 

m 

m 

m  fn 

m  m  m 

G 

© 

o 

© 

© 

o 

©  © 

©  G 

© 

o 

o 

© 

© 

© 

© 

G 

© 

G 

© 

X 

> 

r— < 

«— * 

gpH 

f-H 

r-« 

r— • 

f-H 

G 

© 

© 

© 

© 

G 

©  c 

G  G 

© 

© 

G 

G  © 

© 

© 

© 

© 

© 

© 

r- 

o 

r- 

4 

sr 

4 

4 

St 

-4 

St 

-4- 

>4 

■4 

%\J 

OJ  Oj 

Oj 

rv. 

Oj 

cv,  cv, 

Oj  rv 

rv  Oj 

Oj 

rv  rv 

Oj  OJ  (V  rv 

OJ 

Oj 

• 

4 

>4- 

>4- 

>4- 

>4 

*4 

4- 

iCiOiCiOOiCiOCiC'C'C 

G44444444444 

LL.  uJ  Ul  lU  X  X  I  *  '  1  ■  il  i  t » 1  It  1  1  I 
/>  J  J  J  J  -J  J  O 

"^N'C'C'C'CvD'C'C'C'C'C'C 
u 


- 

-  ~  ~ 

- 

r—i 

- 

- 

o 

e  c 

GO© 

©  ©G  © 

c  ©  © 

©  G 

c  © 

© 

© 

C  © 

Oj  CV 

rv  ~  *-n 

pH  PH  pH 

^ 

•-H  r-H  pH 

H 

4 

© 

© 

o  o  © 

© 

© 

o 

c 

© 

o 

©  G 

G  ©  O 

©  ©  O  © 

©  ©  © 

©  O 

©  © 

c 

© 

cca 

1 

i 

1  1  1 

i 

1 

1 

1 

1 

1 

1  1 

1  1  1 

1111 

i  i  i 

1  1 

1  1 

i 

1 

i  i 

Z 

X 

X 

XXX 

X 

X  X 

X 

X 

u 

X  X  X1  X  X 

ti 1  X  X  UJ  X'  XI  X 

X  X 

X  X 

X 

X 

X  X 

X 

1C 

•  c  i  ©  rv  to  a 

«— 1 

4 

MC 

1C 

r-  x 

cv*©  r*- 

XiWomt  oj  •  ©  r-  x 

rv© 

r-  x 

OJ!  O 

e: 

m 

X 

O  X  X 

r- 

o 

o 

m 

r*> 

4  X 

X  O  p— 

m  tr  r-  cc 

©  CVi  4 

X  h- 

a  — 

Oj 

4 

X  CD 

(V 

m  oj  x 

X 

X 

X 

** 

4  r- 

©  4  r- 

©  m  x  O' 

m  x  O' 

rv  x 

a  rv  a 

—  4 

X 

onvtM>^^^cvi(ViWi 

ojrvojrvojrvcvcvojoj 

oooooooooo 

I  I  I  I  I  I  I  I  I  I 

ll  I  tl  I  ll  I  ll  I  ll  I  ll  I  u  I  ll  I  ll  I  ll  I 

x  X«c.c*c  o*c  *c  c  *c  c  *c 
oommmrommmmmm 


nnnnnnnnnno 
*— •(\jm4xxr,,“000'  o  *— • 


nnn-i^^ifiifiriir.  'O'Cor^M^uccaO'K 

ui 

rv  ojojojojojfvcvojojcvojojrvojojrvojojrv  _j 

o  ooo  oooooooo  ooo  o  o  ©  o  ©  a. 

i  i  i  i  i  i  i  i  i  i  i  i  i  i  i  i  i  i  i  i  x 

XXXXXXXXXXXXXXXXXXXX  o 

irxxirirxxxxxxxtfxxxirxxx  t 

•  ••••••••••••••••••  •  •  h- 

n  nnnnnnnrnnnnrnnnnnnrnno 

UJ 

cv  m  4  in  x  r-  co  O'  o^Mn<#iAvONCDO'OH(\jz 
— 1 


76 


FIGURE  5.4  INITIAL  STATUS  OUTPUT  FROM  GENRAT  FOR  AN  IMPACT  OF  A  1145  ALUMINUM  PLATE  ONTO  A  HOT 
ALUMINUM  PLATE  AT  1.46  x  104  cm/sec 


6.  PRINTED  OUTPUT:  GENRAT,  EDIT,  AND  SCRIBE 


Several  types  of  printed  output  are  provided  during  and  at  the 
conclusion  of  a  calculation.  During  the  reading  of  the  input,  the  input 
lines  are  printed  by  GENRAT  with  some  additional  comments.  Some  material 
property  subroutines  read  their  own  input  and  provide  printout.  After 
the  input  is  read,  a  layout  listing  is  given  by  GENRAT  (or  DEPOS  for  a 
deposition  problem).  During  the  calculation  several  listings  of  the 
layout  with  current  cell  variables  are  made  by  EDIT  (on  a  call  from  SRI 
PUFF).  A  final  EDIT  listing  is  made  at  the  end  of  the  calculation.  The 
SCRIBE  is  called  by  SRI  PUFF  to  print  historical  listings  of  all  requested 
variables.  Besides  these  standard  listings,  there  are  error  messages, 
periodic  messages,  and  special  listings  by  some  material  models.  Samples 
of  these  listings  are  given  in  this  section. 

During  the  reading  of  input  by  GENRAT  and  other  routines,  an  echo 
listing  is  made  of  the  input,  as  shown  in  Figure  6.1.  In  addition  to 
this  echo  printing,  the  GENRAT  listing  includes  prints  to  the  right  of 
the  input  lines  and  some  interpolated  prints  between  input  lines.  The 
prints  to  the  right  show  the  contents  of  the  first  column  on  the  input 
line  (IND),  the  file  containing  the  input  (IN),  and  the  units  of  the 
data  if  read  in  GENRAT.  If  the  input  is  read  by  another  subroutine, 
that  subroutine's  name  is  listed  (e.g.,  DEPOS  and  EXTRA  in  Figure  6.1). 

Inserted  lines  in  the  input  listing  include  the  spaces  separating 
data  groups  and  the  notation  of  an  end-of-f ile  found  by  EXTRA.  EQST 
provides  messages  when  the  McCloskey- Thompson  logarithmic  variation  of 
sublimation  energy  is  used:  some  messages  are  explanatory,  others 
indicate  errors  that  will  cause  a  program  stop.  When  either  the 
Murnaghan  or  linear  shock  velocity  Hugoniot  forms  are  used,  EQST  provides 
a  message.  FMELT  provides  a  message  if  the  FMELT  function  does  not 
monotonically  decrease  with  increasing  internal  energy.  EXPLODE  lists 
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FIGURE  6.1  SAMPLE  GENRAT  LISTING  OF  INPUT  DATA  FOR  A  RADIATION  PROBLEM 


the  type  of  detonation  that  will  occur,  and  the  C-J  parameters  if  a 
running  detonation  is  indicated. 

For  all  problems,  a  listing  of  the  initial  cell  layout  and  principal 
cell  quantities  is  given.  A  GENRAT  layout  listing  is  shown  in  Figure 
6.2.  A  sample  radiation  deposition  layout  from  DEPOS  is  in  Figure  6.3. 

In  the  DEPOS  listing,  a  J  =  0  line  is  provided  for  each  layer  to  permit 
printing  quantities  pertaining  to  the  first  coordinate  point  in  addition 
to  quantities  for  the  first  cell. 

Following  the  layout  listing  is  the  printing  from  PRESCR  of  the 
variables  for  which  a  historical  listing  is  requested.  A  sample  is 
given  in  Figure  6.4.  This  list  is  provided  before  the  propagation 
calculations  so  that  a  verification  of  the  correct  histories  may  be  made 
without  a  complete  run. 

During  the  calculation  there  are  usually  many  calls  to  EDIT  to 
produce  listings  such  as  that  in  Figure  6.5.  The  last  two  columns 
contain  a  variety  of  variables  depending  on  the  material  models  used 
and  the  material  state.  For  the  explosive  (COMPB)  in  the  first  layer, 
the  penultimate  column  provides  FBURN,  the  fraction  of  explosive  deto¬ 
nated.  For  the  HF-l  in  the  second  layer,  the  columns  initially  contain 
the  yield  strength  (Y)  and  deviator  stress  (SD) ,  but  after  shear  banding 
begins  at  a  cell,  they  contain  TAU  =  INL3  and  N,  where  N  is  the  number 
of  shear  bands  per  cubic  centimeter  and  L  is  the  radius  of  the  bands. 

A  sample  of  the  historical  listings  provided  by  SCRIBE  at  the  end 
of  a  calculation  is  in  Figure  6.6.  The  variables  in  the  first  columns 
are  provided  automatically:  cycle  number  N,  problem  time  TIME,  time  step 
DTNH,  calculational  time  for  the  cycle  DELTIM,  and  the  cell  number 
controlling  the  time  step  JTS.  Interface  stresses  are  labeled  S-INT(n) 
where  n  is  the  interface  number  and  n  =  0  means  the  front  surface.  For 
all  other  quantities,  a  standard  label  for  the  quantity  is  followed  by 
the  J  value  in  parentheses. 

Figure  6.7  contains  other  listings  and  messages  found  in  PUFF  output. 
Every  25  cycles  a  message  like  the  periodic  print  in  the  figure  is  given. 
Preceding  the  final  EDIT  listing  at  the  termination  of  the  run,  there  is 
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FIGURE  6.3  SAMPLE  DEPOS  LISTING  OF  THE  CELL  LAYOUT  FOR  A  RADIATION  PROBLEM 
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FIGURE  6.6  SAMPLE  HISTORICAL  LISTING  OF  VARIABLES  FROM  SCRIBE 
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a  message  containing  the  criteria  used  for  stopping  the  run,  as  in 
Figure  6.7.  In  this  case  the  halt  occurred  when  N  =  JCYCS.  Other 
possibilities  are  TIME  >_  TS,  X(JSMAX)  >_  CKS ,  LSUB(7)  =  1,  and  DTNH  < 
l.E  -  12.  LSUB(7)  is  set  to  1  in  HSTRESS  and  FMELT  to  trigger  an  error 
stop . 

Several  material  property  subroutines  provide  regular  listings  in 
the  cycle  just  preceding  an  EDIT.  The  samples  in  Figure  6.7  are  from 
SHEAR2  and  BFRACT3.  EXPLODE  also  prints  a  line  whenever  the  detonation 
is  completed  at  a  cell.  If  the  iterations  do  not  converge  in  CAP1, 
BFRACT3 ,  REBAR,  PEST,  EQSTPF,  TSQE,  BECOM,  or  DFRACT ,  an  error  message 
and  some  information  about  the  cause  and  location  of  failure  is  given. 
REZONE  lists  all  its  major  operations  so  that  difficulties  can  be  traced. 
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Appendix  A 


THERMAL  ENERGY  DEPOSITION 

In  SRI  PUFF,  radiant  energy  is  deposited  gradually  into  the  finite 
difference  cells  over  a  time  corresponding  to  the  source  duration.  This 
appendix  gives  some  background  on  source  characteristics,  radiation 
absorption  information  for  materials,  and  procedures  for  depositing  the 
energy  into  the  material  layers  for  both  normal  and  oblique  incidence 
of  the  radiation.  These  processes  are  all  treated  in  the  DEPOS  subroutine. 
The  interpolation  procedure  used  with  depth-dose  profiles  and  contained 
in  SCATTO  is  also  described. 

Specific  information  for  constructing  the  input  deck  for  radiation 
problems  is  in  Section  5.4,  and  sample  input  is  given  in  Appendix  C. 

Radiation  Absorption  Characteristics 

The  radiation  absorption  calculations  in  PUFF  provide  a  means  for 
determining  the  radiant  energy  absorbed  in  each  finite  difference  cell 
for  x-ray  sources.  Only  absorption  associated  with  the  photoelectric 
effect  is  considered  in  the  calculations.  If  scattering  and  fluorescence 
are  important,  as  they  are  for  photon  energies  larger  than  a  few  keV, 
an  appropriate  deposition  code  like  FSCATT  should  be  used  to  obtain  a 
depth-dose  profile  for  the  PUFF  calculations. 

The  geometry  assumed  in  the  absorption  calculations  is  planar. 
Cylindrical  or  spherical  geometries  must  be  treated  by  means  of  a 
depth-dose  profile  or  by  detailed  initialization  of  internal  energy 
(EHL)  or  the  SS  array  through  a  NAMELIST  statement. 
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Typical  radiation  absorption  characteristics  associated  with  the 
photoelectric  effect  are  illustrated  in  Figure  A.l.  The  sharp  discon¬ 
tinuities  in  the  absorption  occur  at  photon  energies  related  to  the 
orbits  of  the  electrons.  The  discontinuity  farthest  to  the  right  is 
called  the  K  edge  because  it  is  associated  with  electrons  in  the  K  shell. 
The  next  edges  to  the  left  are  L,  M,  and  N  edges.  Between  the  edges 
the  absorption  function  varies  smoothly,  approximately  following  the 
function 


a  « 
a 


(hv) 


(A.l) 


where  C  is  the  mass  absorption  coefficient  and  hv  is  the  photon  energy 
a 

(V  is  frequency  and  h  is  Planck's  constant).  In  standard  tables,  such 

41  .42 

as  those  of  McMasters  et .  al.  and  Fisher  and  Wiehe,  the  absorption 
coefficient  is  expanded  in  the  following  form  between  edges: 


In  a 

a 


+  Aw 


A^w 


A^w~ 


(A. 2) 


where  C the  mass  absorption  coefficient,  barn/atom 

w  =  ln(hv) 

hv  =  pboton  energy,  keV 

Aq  . . .  A^  =  coefficients  of  the  fit. 


Because  the  absorption  coefficient  follows  Eq.  (A.l),  A^  is  approximately 
equal  to  -3. 

For  absorption  by  the  photoelectric  effect,  there  is  an  exponential 
attenuation  of  energy  through  a  layer  of  material.  The  fraction  of  the 
fluence  1^  (with  a  specific  photon  energy)  transmitted  through  a  thickness 
AX  is 


7-  =  exp  (-y  AX)  (A.  3) 

0  a 


88 


In  o ,  MASS  ABSORPTION  COEFFICIENT 


MA-6802-4 


FIGURE  A.1  TYPICAL  VARIATION  OF  PHOTOELECTRIC  MASS  ABSORPTION 
COEFFICIENT  WITH  PHOTON  ENERGY 
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where  y  is  the  linear  absorption  coefficient  with  units  of  1/cm 

Si 

appropriate  to  the  incident  photon  energy  (Here  we  are  considering 

normal  incidence  only;  Section  4  treats  the  case  of  oblique  incidence.) 

The  coefficient  y  is  related  to  a  as  follows, 
a  a 


pc  N  a  pa 

y  =  =  0.602252 

a  A  A 

w  w 


(A. 4) 


where  p  =  density,  g/cm 
C, 


-24  2 

10  cm  /barn,  a  conversion  factor 


23 

N  -  6.02252  x  10  ,  Avogadro's  number,  atom/mole 

a 

A^  =  atomic  weight,  g/mole 

a  =  mass  absorption  coefficient,  barn/atom. 


With  the  coefficients  AQ,  . . .  A^  and  Eqs .  (A. 2)  to  (A. 4),  the  attenuation 
and  absorption  of  energy  can  be  calculated  for  any  source  with  a  single 
photon  energy. 

3 

y  =  0.602252  f  Z  A.  [ln(hv)]1  (A. 5) 

3  w  i=0  1 

Use  of  these  absorption  characteristics  to  treat  attenuation  of  radiation 
from  a  source  with  a  range  of  photon  energies  is  described  in  the 
following  sections  of  this  appendix. 

For  multiple  constituent  materials,  absorption  coefficient  informa¬ 
tion  is  entered  for  each  constituent.  Such  materials  may  be  either 
mixtures  or  compounds  of  any  kind.  Common  examples  are  a  metal  alloy 
or  an  epoxy  resin.  In  such  materials  the  absorption  coefficients  are 
defined  and  entered  in  the  usual  fashion  for  each  constituent,  and  then 
a  composite  absorption  coefficient  is  calculated  in  the  program.  The 
composite  absorption  coefficient  is 
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C  J 

ya  =  0.602252  £  £  A  in  [ln(hv)]L 

n  =  1  Wn  i=0 


(A. 6) 


where  N  =  the  number  of  constituents 
c 


A  =  the  atomic  weight  of  the  nth  constituent 
wn 


A.  =  the  coefficients  in  the  absorption  function  for 
in 

the  nth  constituent. 


Here  p  is  the  weight  fraction  of  the  nth  constituent  times  the  composite 


n 

density.  Hence 


N 


(A. 7) 


P, 


n 


Radiation  Sources 

Since  the  radiation  sources  permitted  in  the  program  are  all  steady 
state,  only  an  emittance  history  and  a  single  emittance  spectrum  are 
required.  The  emittance  or  flux  history  is  that  shown  in  Figure  A. 2, 
with  an  abrupt  start,  a  constant  value  for  the  duration  of  deposition, 
and  an  abrupt  stop. 

Two  types  of  sources  are  accounted  for  in  the  absorption  calculations 
an  arbitrary  spectrum  and  one  made  up  of  several  black  body  radiators. 

For  the  arbitrary  spectrum  the  user  divides  the  energy  into  several  energy 
packets,  each  at  a  specific  photon  energy,  and  pairs  of  values  of  energy 
and  hV  (photon  energy)  are  read  in. 

For  the  black  body  source,  some  standar ization  is  possible  because 

of  the  simple  relation  between  radiant  emittance  and  the  photon  energy. 

43 

According  to  Sears  for  a  black  body  of  unit  energy,  the  radiant 
emittance  dW  is 


(A. 8) 
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RATE  OF  ENERGY  DEPOSITION 


FLUX  = 


ECAL 

STOP-START 


FIGURE  A. 2 


START 


TIME 


STOP 


G  8  -6586-7 

HISTORY  OF  RADIATION  SOURCES  CONSIDERED  IN  THE  PROGRAM 


92 


where 


0)  =  hV/kT,  a  nondimen sional  quantity  proportional  to  photon 
energy 

h  =  Planck’s  constant 
V  =  frequency  of  the  photons 
hV  =  photon  energy,  usually  in  keV 
k  =  Boltzmann  constant 
T  =  Kelvin  temperature 

kT  =  temperature  in  energy  units,  usually  keV  (Planckian 
temperature) . 

The  variation  of  radiant  emittance  with  photon  energy  is  shown  in 

Figure  A. 3.  The  total  emittance  of  the  black  body  is  the  area  under  the 

curve.  For  calculations  in  the  program,  the  spectrum  has  been  divided 

into  93  energy  packets.  Each  energy  packet  is  located  at  a  discrete 

hV  value  (BBDY  in  the  program).  The  energy  (EIBB)  in  each  packet  was 

determined  by  integrating  the  area  under  the  emittance  curve  over 

appropriate  ranges  of  hV  to  determine  AW  from  Eq .  (A. 8)  (as  shown  in 

Figure  A. 4),  The  black  body  spectrum  is  completely  specified  by  a 

Planckian  Temperature  kT  (TEMP  in  the  program, keV)  and  the  total  fluence 
2 

(ECAL,  cal/ cm  ) . 

Deposition  Computations 

Radiation  deposition  by  means  of  an  absorption  calculation  is 
provided  for  two  types  of  sources:  a  black  body  or  bodies,  and  an 
arbitrary  spectrum.  The  deposition  of  radiation  from  either  a  black 
body  or  an  arbitrary  spectrum  is  obtained  by  computing  the  absorption 
of  each  energy  packet  (located  at  a  discrete  value  of  hv)  using  the 
absorption  coefficient  corresponding  to  that  value  of  hv.  The  penetra¬ 
tion  of  the  radiant  energy  into  the  material  is  given  by  an  exponential 
relation  as  shown  in  Figure  A. 5.  Then  within  a  cell  thickness  X,  the 
increment  of  energy  is 


93 


EMITTED  SPECTRUM 


PEAK  AT  u)  =  2.83 


2  4  6  8 

NONDIMENSIONAL  PHOTON  ENERGY,  w  =  hi>/kT 


GA-6586-8 


FIGURE  A. 3  EMITTANCE  SPECTRUM  FOR  BLACK  BODY 
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PHOTON  ENERGY,  hv 


G  8-6586-6 


FIGURE  A. 4  SPECTRUM  OF  A  RADIATION  SOURCE 


95 


(A. 9) 


where 


=  the  amount  of  energy  reaching  the  left  face  of  the  cell 
Ax  =  the  thickness  of  the  cell. 


Because  y^  is  a  function  of  hv,  Eq.  (A. 9)  can  be  used  only  for  particular 


values  of  hv,  that  is,  for  energy  packets  located  at  the  hv  values.  To 
provide  reasonable  accuracy  in  the  deposition,  it  is  necessary  to  provide 
a  large  number  of  hv  values  (109  values  of  hv  are  permitted  in  the  present 
dimension  statement) .  The  large  number  of  hv  values  is  desirable  because 


the  program  selects  a  single  value  of  y  for  each  abscissa,  and  the 

a 

function  of  y  versus  hv  is  extremely  uneven,  as  shown  in  Figure  A.l. 
a 


In  DEPOS  the  deposition  into  the  grid  is  accomplished  by  inserting 
the  energy  from  the  various  spectral  sources  into  an  array  SS  for  each 
cell.  During  the  wave  propagation  calculations,  this  energy  will  be 
gradually  inserted  into  the  internal  energy  in  the  cell.  A  value  of  SS 
is  computed  for  each  cell  and  for  each  source.  The  equation  for  the 
energy  deposited  in  the  j th  cell  in  an  increment  of  time  At  is  given  by 


AE  . 

J 


j 


(A. 10) 


where 


C 


Z  . 
J 


c 


2 

the  total  energy  in  cal/cm  to  be  deposited  in  the 
jth  cell  from  the  nth  source 

a  conversion  factor,  4.186  x  10^  erg/cal 

2 

the  mass  of  the  jth  cell,  g/cm 


the  duration  of  the  nth  source. 


96 


ENERGY  OF  A  PACKET, 


FIGURE  A. 5 


PENETRATION  OF  ENERGY  INTO  A  MATERIAL 
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Then  the  deposited  energy  AE^  is  in  erg/g.  The  array  SS  is  defined 
to  include  all  the  constant  quantities  in  Eq .  (A. 10),  that  is,  all 
except  At. 


C  E 


RJ 


Z  .ATn 
J 


(A. 11) 


During  the  wave  propagation  calculations,  the  manipulations  with  the 
array  SS  are  conducted  in  the  function  SSCALH. 


Radiation  Deposition  at  Oblique  Incidence 

For  a  monoenergetic  source  at  normal  incidence,  the  radiation  is 
absorbed  into  a  material  according  to  the  standard  exponential  law: 


E 


E  e 
o 


'V 


(A. 12) 


where 


E^  -  the  incident  energy 
E  =  the  intensity  at  any  depth,  X. 


If  the  incidence  is  not  normal  then  Eq .  (A. 12)  is  modified  in  two  ways: 
the  intensity  at  the  front  is  reduced  by  the  cosine  of  the  angle,  and 
the  depth  is  increased  by  the  cosine.  Thus  the  equation  becomes 


-y  X  sec  0 

E  =  E  cos  0  e  a 
s  o 


(A. 13) 


where  0  is  the  angle  from  normal  incidence.  Equation  (A. 13)  is  shown 
in  Figure  A. 6 . 

The  absorbed  energy  in  erg/g  is  determined  as  the  difference 
between  incident  and  transmitted  fluence,  divided  by  the  mass. 
Considering  a  small  cell  of  material  with  lengths  AX,  AY,  and  AZ,  the 
incident  fluence  is 
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NON  DI  MENSIONAL  INTENSITY  E.'E 


MaX 


nondimensional  depth 


M  A-6802-5 


FIGURE  A. 6  RADIATION  INTENSITY  AS  A  FUNCTION  OF  DEPTH  FOR  SEVERAL 
INCIDENT  ANGLES 
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AYAZ 


-p  X  sec  0 

E  .  AY  AZ  =  E  cos  0  e  a  1 
SI  o 


and  the  mass  is 


Z  . 
J 


=  pAXAYAZ 


Therefore,  the  absorbed  energy  is 


AE 

a 


(E  .  -  E  0)  AYAZ 
si _ s2 

pAXAYAZ 

-y  AX  sec  0 
E  cos  0  e  a 


Z  . 
J 


(A. 14) 


Depth-Dose  Profile  Interpolation 

When  a  depth-dose  profile  for  the  radiation  is  provided  by  a  table 

of  energy-distance  values,  the  energy  for  each  PUFF  cell  is  determined 

by  interpolation.  These  interpolations  are  performed  in  the  subroutine 

SCATTO.  The  depth-dose  profile  may  represent  depositions  from  an 

electron  beam,  a  laser,  or  an  x-ray  source,  and  may  be  determined  either 

experimentally  or  analytically.  To  account  for  x-ray  absorption  by 

scattering,  fluorescence,  and  the  photoelectric  effect,  we  have  used 

42 

the  FSCATT  code  of  Fisher  and  Wiehe.  The  FSCATT  results  provide 

deposited  energy  (e.g.,  cal/g)  at  coordinate  points  in  a  finite  difference 

2 

grid  for  a  unit  of  radiant  energy  (e.g.,  1  cal/cm  ).  All  depth-dose 
profiles  are  assumed  to  have  this  form. 

For  PUFF  calculations  the  deposited  energy  is  an  average  quantity 
over  the  cell  thickness,  whereas  the  depth-dose  profile  provides  energies 
at  discrete  depths.  The  PUFF  cell  energies  are  derived  by  interpolating 
between  points  in  the  depth-dose  profile  and  then  integrating  over  the 
PUFF  cell  dimensions. 
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The  approach  taken  for  the  interpolation  is  to  assume  that  the 
deposited  energy  is  representable  by  a  smooth  function  that  can  be  de¬ 
fined  by  energy  values  at  the  depths  given  in  the  depth-dose  profile. 

This  function  is  then  integrated  over  each  PUFF  cell  dimension  to  find 
the  energy  deposited  therein.  The  energy  is  assumed  to  span  across  three 
depths  in  the  given  profile  and  to  have  the  form  of  a  parabola  in  a  semi¬ 
log  plot.  An  expression  for  this  parabolic  form  is 


E 

s 


(A. 15) 


where  E  =  the  energy  at  any  depth 

E  ,  E  E  =  energies  at  the  given  depths  in  the  depth-dose 
si  sz  si 

profile 


^2 


(X  -  x2)(x  -  x3) 


(X, 


X2)(X1  ”  V 


(X  -  x1)(x  -  x3) 
(X2  -  X1)(X2  -  X3) 
(X  -  xpcx  -  x2) 


(X, 


V (x3  “  V 


x  =  depths  in  the  depth-dose  profile. 


The  form  of  Eq .  (A. 15)  is  suggested  by  the  shapes  of  deposition  curves 

that  are  essentially  exponential,  except  near  material  boundaries,  where 
they  may  be  more  rounded.  The  energy  (Ep  deposited  in  the  jth  PUFF 
cell  per  unit  of  fluence  is  the  average  of  between  the  cell  coordinates, 
X.  and  X.+^.  This  average  is  expressed  by  the  integral 

'X, 


5+1  "  J  * 


j+i 


E  dX 

S 


(A. 16) 


j 


This  integration  is  performed  numerically  using  Simpson's  rule. 
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The  function  in  Eq .  (A. 15)  best  represents  the  variation  of  de¬ 
posited  energy  in  some  middle  portion  of  the  three  depths  used  in  the 
interpolation.  Therefore,  it  was  decided  to  use  the  function  defined 
by  three  depths  only  from  the  middle  of  the  first  pair  of  depths  to  the 
middle  of  the  second  pair.  Figure  A. 7  shows  the  profile  depths  that 
contribute  to  the  deposition  in  each  PUFF  cell. 

The  final  step  in  the  deposition  is  to  initialize  the  SS  array  in 
a  manner  similar  to  that  described  above  for  deposition  computations. 

The  energy  in  each  PUFF  cell,  E_f,  is  based  on  one  unit  of  radiated 
energy.  Therefore,  the  actual  absorbed  energy  in  any  cell  from  a  source 
with  a  total  fluence  of  Ecal  is  Ej  '  Ecal*  Then  the  expression  for 
computing  values  for  the  SS  array  is 


c  e: 
ssn  =  c  J 


Jcal 


AT 


The  SS  array  is  used  in  the  function  SSCALH  to  provide  energy  increments 
for  each  cell  during  the  propagation  calculations. 
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MATERIAL  BOUNDARIES 
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DEPTHS  USED  IN  THE  DEPTH-DOSE  PROFILE 
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RANGES  FOR  FUNCTIONS  DEFINED  BY  3  COORDINATES  IN  EQUATION  (A. 15) 
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FIGURE  A.7  PATTERNS  FOR  INTERPOLATION  OF  THE  RADIANT  ENERGY  IN  A 
DEPTH-DOSE  PROFILE  TO  OBTAIN  ENERGIES  FOR  PUFF  CELLS 
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Appendix  B 


CALCULATIONS  FOR  EXPLOSIVES 


This  appendix  outlines  a  simple  detonation  theory  based  on  standard 
references  such  as  Taylor.^*4  Then  the  types  of  detonation  provided  in 


PUFF,  the  input  required,  and  the  algebra  of  the  code  calculations  are 
described . 

Background  on  Detonation  Processes 

Three  substances  are  involved  in  a  detonation  process:  the  unreacted 
explosive,  the  reacting  explosive,  and  the  product  gases.  Here  we  will 
presume  that  the  unreacted  explosive  and  the  product  gases  can  be  repre¬ 
sented  by  equations  of  state  with  the  pressure-volume  isentropes  shown 
in  Figure  B.l.  During  detonation,  the  chemical  energy  in  the  explosive 
is  transformed  to  internal  energy  and  the  state  point  moves  from  the 
unreacted  curve  to  the  product  curve  of  Figure  B.l.  In  Chapman  Jouguet 
detonation  theory,  the  reaction  occurs  within  the  shock  front.  In  a 
steady  detonation,  the  material  follows  a  Rayleigh  line  from  the  initial 
density  to  a  point  of  tangency  on  the  products  curve  as  shown.  The  point 
of  tangency  is  the  Chapman- Jouguet  or  C-J  point.  The  pressure,  volume, 

and  energy  at  this  point  are  labeled  P  ,  V  ,  and  E  .  If  the  product 

J  LJ 

gases  are  assumed  to  follow  a  polytropic  gas  equation  of  state,  that  is. 


Y 

PV  =  constant 


(B.l) 


then  relations  for  the  detonation  velocity  (D  ),  P^T,  VOT,  E^,  and  the 


poly tropic  gas  relations,  Hugoniot  jump  conditions,  energy  conservation, 
and  the  condition  of  tangency  at  the  C-J. point. 


(B.2) 
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PR  ESSUR  E 


MA-68  02-13 


FIGURE  B.  1  PRESSURE-VOLUME  PATHS  FOLLOWED  IN  DETONATION  PROCESS 
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where  =  the  energy  of  the  explosive 
=  the  initial  density. 

The  polytropic  gas  exponent  is  related  to  the  Griineisen  ratio  as  follows 

Y  -  r  +  1  (B . 7 ) 

For  many  common  explosives,  y  values  range  from  2.5  to  3.0.  This 
exponent  describes  the  product  gas  isentrope  adequately  down  to  a  few 
kilobars.  For  lower  pressures,  the  apparent  y  value  decreases  gradually 
to  about  1.5  at  ambient  conditions. 

Besides  the  Chapman-Jouguet  process,  several  other  detonation 
processes  may  occur  in  explosives.  Von  Neumann  suggested  that  in  a 
steady-state  running  detonation,  the  pressure  in  the  shock  rises  to  the 
point  V.N.  in  Figure  B.l  and  then  reduces  gradually  to  C-J  as  the 
chemical  reaction  occurs.  Path  C  is  typical  of  computed  pressure-volume 
paths  followed  during  the  buildup  to  a  steady-state  detonation.  Here 
the  chemical  reaction  is  occurring  during  the  loading  by  the  stress 
wave.  If  the  explosion  occurs  without  a  change  in  volume,  the  vertical 
path  to  the  constant-volume  point  C-V  is  followed.  The  Chapman-Jouguet, 
von  Neumann,  constant-volume,  and  various  gradual  detonation  processes 
have  all  been  used  to  represent  explosive  phenomena.  Only  the  Chapman- 
Jouguet  and  constant-volume  processes  are  currently  available  in  PUFF. 

The  detonation  type  used  in  the  calculation  should  match  as  nearly 
as  possible  the  explosive  behavior  and  geometry  being  considered.  For 
example,  if  a  block  of  explosive  next  to  a  plate  is  detonated  at  a  point 
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on  the  block  opposite  the  plate,  the  detonation  front  will  reach  the 
plate  as  a  plane  wave;  this  process  should  be  simulated  as  a  running 
detonation.  If  the  detonation  occurs  such  that  the  wave  front  sweeps 
past  the  plate,  however,  a  cons tan t- volume  explosion  gives  a  better 
representation  of  the  impulse  applied  to  the  plate  (the  actual  wave 
front  is  not  moving  in  the  direction  of  motion  in  PUFF) .  In  some  prob¬ 
lems  the  stress  histories  in  the  explosive  are  not  important  (as  in  the 
impact  of  an  explosively  driven  flyer  plate) ;  then  a  const ant -volume 
calculation  will  adequately  represent  the  impulse  applied  by  the  explo¬ 
sive. 

Computation  of  Detonation  Processes  with  the  Subroutine  EXPLODE 

The  Chapman- Jouguet  and  constant-volume  detonation  processes  are 
incorporated  into  the  EXPLODE  subroutine.  This  routine  may  be  called 
to  perform  three  different  functions:  reading  input,  initializing  cells, 
and  computing  the  pressure  for  the  running  detonation. 

The  input  for  an  explosive  calculation  includes  Q  ,  X  ,  and  b  and 

x 

is  read  during  the  first  call  to  EXPLODE  from  GENRAT.  If  a  constant- 

volume  explosion  is  desired,  only  the  chemical  energy  Q  is  provided. 

x 

Xp  is  the  initiation  point  for  a  running  detonation  and  b  is  the  number 
of  cells  over  which  a  detonation  front  is  spread.  Nominal  values  of 
b  are  2  to  4. 

At  the  second  call  to  EXPLODE,  the  energy  and  density  of  cells 
containing  explosive  are  initialized.  This  call  is  made  from  GENRAT 
during  the  cell  layout  process.  For  a  constant-volume  explosion,  the 
internal  energy  is  equated  to  Q  ,  and  F  (the  detonated  fraction)  is 

X  -D 

set  to  1.0  to  show  that  detonation  has  taken  place.  The  calculations  of 
pressure  during  the  propagation  process  are  then  all  treated  in  a  section 
of  EQST. 

For  a  running  detonation,  only  cells  near  the  detonation  point  are 
initialized  at  the  second  call  to  EXPLODE.  The  reacted  fraction  of 
a  cell  is  computed  based  on  the  distance  of  the  cell  midpoint  from  the 
initiation  point. 
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F 


B 


1 


bAX 


(B .  8) 


where  X  =  the  cell  midpoint 

AX  =  the  cell  length  in  the  direction  of  propagation. 

From  eq.  (B.8)  it  appears  that  the  cell  midpoint  must  be  within  a  distance 

bAx  of  the  initiation  point  for  any  initiation  to  occur.  For  F  >0, 

B 

the  pressure,  density,  and  internal  energy  are  augmented  to  represent 
a  point  along  the  C-J  detonation  path  in  Figure  B.l.  Hence 


P  =  P  F 
CJ  B 


(B .  9) 


P  = 


1  +  VVCJPo  '  « 


(B. 10) 


E  =  Q  +  (E  -  Q  )FB 
x  CJ  x 


(B . 11) 


This  energy  calculation  appears  adequate,  although  it  is  not  justified 
analytically. 

The  third  call  to  EXPLODE  is  made  in  HSTRESS  and  only  for  a  running 
detonation.  The  purpose  of  the  call  is  to  compute  pressure  and  energy 
during  the  reaction  process;  the  pressure  of  fully  detonated  material 
is  treated  by  EQST.  First,  the  time  t^  to  begin  burning  is  computed. 


h  = 


1 

X 

1 

IX 

-  b  A  X 

D 

D 


(B. 12) 


X 


The  fraction  detonated  is  then 


fb  ■ 


(t  -  CB>  Ex 

bA  X 


(B . 13) 


where  t  is  the  current  problem  time.  Because  of  the  absolute  value  sign 
in  Eq.  (B.12),  the  detonation  can  proceed  in  either  direction  from  the 
initiation  point.  Given  the  detonated  fraction  F  ,  the  pressure  and 
energy  are  computed  both  from  the  usual  polytropic  gas  relations  and 
as  fractions  of  the  C-J  values.  The  pressure  and  energy  values  for 
the  cell  are  taken  as  the  maxima  from  these  two  calculations. 
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Appendix  C 


DESCRIPTION  OF  INPUT 

This  appendix  provides  some  sample  input  decks  and  supplements  the 
input  description  provided  in  Section  5.  The  construction  and  use  of 
a  data  bank  is  outlined;  the  bank  can  be  a  permanent  or  temporary  file 
containing  material  properties  or  other  data.  A  procedure  for  reading 
special  data  through  a  NAMELIST  statement  is  given,  and  the  method  for 
entering  variables  to  obtain  historical  listings  of  any  array  quantity 
at  any  cell  is  described.  The  meaning  of  the  indicator  NVAR  is  given  to 
aid  in  incorporating  new  material  models,  in  calculating  with  models 
having  large  numbers  of  variables,  or  in  getting  data  from  large  models. 

Data  Banks 

A  data  bank  for  PUFF  is  a  file  containing  some  portion  of  the  input 
for  a  problem.  Specifically,  the  data  may  be  card  images  representing 
the  general  running  information  of  Section  5.1,  a  complete  set  of  pro¬ 
perties  for  a  material,  x-ray  radiation  absorption  coefficients  for  a 
material,  an  x-ray  spectrum,  or  a  depth-dose  profile  for  a  radiation 
problem.  Sample  data  banks  are  shown  in  Figure  C.l  and  C.2.  After 
describing  the  banks,  we  outline  their  use  in  setting  up  problems. 

The  two  banks  in  Figures  C.l  and  C.2  were  constructed  by  inserting 
them  like  data  decks  for  reading  by  GENRAT .  The  first  line  of  the  data 
must  read 

__DATA  or  __ABS  DATA 

where  either  word  starts  in  column  2.  On  reading  the  word  "DATA" , 

GENRAT  places  the  next  card  images  up  to  an  end-of-file  (the  7/8/9  card) 
on  Tape  4,  whereas  "ABS  DATA'1  indicates  a  write  to  Tape  2.  Material 
properties  data,  general  running  information,  spectral  data,  and  depth 
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-OATA-  IN  COLUMNS  2-5  INOICATES  A  OATA  BANK  FOR  TAPE  4 


HEADING 

SHOCKEY 

NTEDT  ■ 

0 

NJEOIT  * 

1 

NREZON  * 

0 

NALPHA  = 

1 

JEDIT  * 

14  16 

10  20 

21 

22 

23  24 

26  20 

NED  IT  *= 

1  0 

JCYCS  * 

200 

CKS  = 

10  • 

TS  = 

1  • 

NMTRLS  = 

2 

MATFL  = 

1 

UZERU  = 

0. 

1145  AL 

RHOS  - 

2.  704 

CFP  =  000 

DP  Y  =  50  3 

EQST  = 

0. 560EM 1 

0  • 

1 • 000E  +  1 1 

2. 1 

2.  1 

0AUSCH  = 

3. 000E-02 

4.000EM 0 

4.000E-M0 

2  .0 OOE-O  1 

YIELD  = 

4.  130E  +  09 

3.00  OE  ■*- 1  1 

vise  - 

4.0 

0.05 

0.05 

EMELT  = 

6.6  0  OE  ♦ 0  9 

5. 000E+09 

0. 

1  •  0 

0.25 

1145  AL  HOT 

RHOS  - 

2.70452 

CFP  =  010 

DP Y  =  003 

EQ  ST  = 

8.560E+ 1 1 

0. 

1  •  000E+  1 1 

2.1 

2.1 

OF  R  1  = 

-.00625  -4.000E+09 

1  *  0  0  OE  — 

04 

2.000EM  2 

-3.000EF0  9 

0. 960  EF  09 

YIELD  - 

2. 000E+09 

3  .000EM 1 

vise  = 

4.0 

0.05 

0.05 

EMELT  = 

6 .600EF09 

5.000E+09 

0  • 

l  .0 

0.25 

ARMCO  SH 

dAND 

RHOS  = 

7.85E0 

CFP=  030 

DP  Y—  002 

NVAR  =  58 

NC  ON  = 

0 

EQ  ST  = 

1 • 509EM 2 

5. 17  OEM  2 

7. 360EF  10 

1 • 69E0 

0.25E0 

5.17  OE  M3 

SH2 

3. 000EF0 1 

. 2000E+00 

1  .  100E- 

02 

3. 000E-04 

0.17 

0 • 070E+00 

0 .070E+00 

1 . 4 

3 .000E-08 

3.000E4-08 

6. 

•  2 

.  1  7 

7. 000E4-09 

NSI  ZE 

0  0 

0  8 

0 

8 

0  0 

0 

MELT  = 

1 • O05E+  1  0 

6. 460E+09 

5. 700E- 

01 

7.000E-0 1 

1 .850E-01 

YIELD  = 

2 . 0  0  0  E  +0  9 

0. 1 90E  M  1 

HF-1  SH  8AN0 

RHOS  - 

7.  05EO 

CFP=  030 

DP  Y  =  002 

NVAR  =  58 

NC  ON  = 

0 

EQST  a 

1  •  5  89  EM  2 

5 •  1  7  OE  M 2 

7 . 360E  MO 

1 . 6  9E  0 

0. 25E0 

5.17  OE  M3 

SH  2 

3.000E401 

•  2000E  +  00 

1 . 100E- 

02 

1 . 000E-03 

0.17 

0 . 070E+00 

0 .070E+0C 

1 .4 

3.0  0 OE—  0  8 

3.000E+08 

6  . 

•  2 

.  1  7 

7.000E+09 

NS  IZE 

0  0 

0  0 

8 

8 

0  0 

0 

YIELD  = 

1 . 030E+  1  0 

0. 1 90E ♦ 1 1 

MELT  = 

1 • O05EM 0 

1  .000E4-C3 

0  •  EC 

9 .975E-0 1 

1  • 0  0  OE - 0  1 

PM  M  A—  8K  d 

(BARKER)  RHOS  = 

1 • 1 84F*  CO 

CFP  -  000 

□PY  -  001 

EQST  - 

7.000EM0 

4  .050E4- 1  1 

1 .000EM0 

1  .000E+00 

2 . 50  OE- 0  1 

39640E4-  1  1 

YIELO  = 

1 .000EF06 

1  •  95  OE ♦  1  0 

2. 850E+09 

HF-1 

RHOS  * 

7 . 85E0 

CF  P-  000 

OP  Y=  002 

NC  QN  — 

0 

EQ  ST  = 

1 • 509E+ 1 2 

5.  1  70EM2 

7. 360E+  10 

1  . 6  9E  0 

0.25E0 

5. 170EM  3 

YIELD  = 

1 .C30EM0 

0 .1  90EM  1 

MELT  = 

1 . 085EM0 

1  .  OOOE  +  00 

o 

m 

o 

9. 975E-0  1 

1  .OOOE-O 1 

L  E AO  (KOHN) 

RHOS  = 

1  1  .  355 

CFP  =  000 

DPY  =  000 

EQST  = 

5. OO0EF 1 1 

4.906EM  1 

9.1  55E4-09 

2.2 

0.25 

2.01  9EM  2 

SPEC  Z12 

NHNU  = 

95 

<  4 ( F  10.5.F7. 5.3X)  ) 

.035  71 

•  00000 

.  10714 

.00000 

.17057 

.00000 

.25000 

.00000 

•  321 43 

.00001 

•  39206 

•  00002 

.46429 

.00003 

.53571 

.00004 

.60714 

.00006 

•  67857 

.00009 

.75000 

.00012 

.82143 

•  000  1  6 

. 89206 

.00021 

•  96429 

.00026 

1 .07143 

.00093 

1 .21429 

.00156 

1 .35714 

.00209 

1  .50000 

.00254 

1 .64286 

.00290 

1  .7057  1 

.003  1  6 

1 .92057 

•  0C333 

2.00333 

.00436 

2 .25000 

.00500 

2.41667 

.00565 

2.50333 

•00600 

2 • 7500  C 

.00635 

2.91667 

.00640 

3. 1 2500 

.00993 

3. 37500 

•  C  1053 

3 • 62500 

•  C  1  145 

3 .87500 

.01269 

4 .12500 

.01420 

4. 3750C 

.01 563 

4.62500 

.01684 

4.07500 

.01 782 

5  •  1 6667 

.02577 

5.50000 

.02789 

5.83333 

.02004 

6.16667 

.02976 

6. 50000 

.030  75 

6.83333 

.03069 

7. 16667 

.03060 

7.50000 

.03062 

7.03333 

.02941 

8.25000 

.04213 

0.75000 

.03797 

9.25000 

.03100 

9. 75000 

.02602 

1 0.25000 

.02130 

10.75000 

.01 842 

1 1  .25000 

.0 1 734 

1  1  • 75  0  C  0 

.01616 

12.25000 

.01546 

12. 75000 

.01464 

13.25000 

.01 379 

13.75000 

•01311 

14.50000 

.02460 

15.50000 

. C  2200 

16.50000 

.02070 

1 7.50000 

.01 070 

1 0.50000 

.01720 

1 9.50000 

•01610 

20.50000 

.01 530 

21  .50000 

•01400 

22.50000 

.01450 

23.50000 

.01 4C0 

24.50000 

.01160 

2  5.  50  0C0 

•  00600 

26.50000 

.00440 

27. 50000 

.00580 

20.50000 

.00720 

29.50000 

.00730 

30.50C  00 

. 0  C  6 00 

31  .50000 

.00630 

32.50000 

.00590 

33.50000 

•  00550 

34. 500  00 

.00510 

35.50000 

.00480 

36.50000 

•  0 C  44  0 

37.50000 

•  004  1  0 

30.50000 

.00370 

39.50000 

.00340 

40.50000 

.00320 

41 .50000 

.00290 

42.50000 

•00270 

43 .50000 

.00250 

44 .50000 

.00230 

45.50000 

•  0  02  1  0 

46.50000 

.00200 

47.50000 

.00180 

48.50000 

.00170 

49.50000 

.001 60 

51 .25000 

.00204 

53. 75000 

.00376 

57.50000 

•  00490 

7/8/9 


FIGURE  C.1  DATA  BANK  CONTAINING  GENERAL  RUNNING  INFORMATION,  MATERIAL 
PROPERTY  DATA,  AND  A  SPECTRUM  (ON  TAPE  4) 

112 


*** 


ASS  OATA 

*•*  ABSORPTION  EOGE  ANO  COEFFICIENT  OATA  BORROWED  MAINLY  FROM  THE  F  SCAT  T 

CODE  OF  S.S.S*  THE  OATA  ARE  FROM  THE  LLL  COMPILATION  OF  X-RAY  CROSS  * ** 


*•*  SECTIONS.  BY  W.  H.  MCMASTERS.  ET.AL..  SECT. 2.  REV.  1.  MAY.  1959  *•* 

* 

VALUE  OF  COEFFICIENTS  USEO  IN  FIT  OF  CROSS  SECTION  OATA  EQUATION  -  *** 

***  LN(S IGMA/S 1GNAO )»A(0. I » ♦A ( 1 • I )*X4A< 2. 1 > *X* *24A< 3. I)*X**3  *** 

*•*  WHERE  X-LN(HNU)  SI TH  HNU  IN  KE V .  S I GMAO*l I B ARN/ ATOM ) .  SUBSCRIPT  -1-  *** 

***  REFERS  TO  THE  FIT  PAST  THE  ITH  EOGE.  *** 


HYDROGEN 

X-RAY  ABS  NOE 

S 

1 

ATWT  = 

1  .000 

1 

H 

EOGE1 

1 . OOOOOE 

0 

1 

H 

COEF  1 

2 • 44950E 

0 .-3.34932E 

0 

.-4 

. 7  2054  E 

-2.  7.10529E  -3 

1 

H 

HELIUM 

X-RAY  ABS  NOE 

— 

1 

ATWT 

4. 0026 

2 

HE 

EOGE  1 

1 .OOOOOE 

0 

2 

HE 

COEF  1 

6.O6A90E 

0 3. 29055E 

0 

.- 1 

. 07282E 

-  1  .  1  .44502E  -2 

2 

HE 

LITHIUM 

X-RAY  ABS  NOE 

- 

1 

ATWT  = 

6.9390 

3 

L  1 

EOGE  1 

1  .OOOOOE 

0 

3 

L  1 

COEF  1 

7 • 75366E 

0.-2. 01790E 

0 

.-2 

.4  174  IE 

-  1  .  2 .6254  IE  -2 

3 

L  1 

beryllium 

X-RAY  ABS  NOE 

- 

1 

ATWT  = 

9.0120 

4 

BE 

EOGE  1 

1  .OOOOOE 

0 

4 

BE 

COEF1 

9.0450  3E 

O.-2.0349OE 

0 

.-2 

• C9990E 

-1.  2.29400E  -2 

4 

BE 

00  HON 

X-RAY  ABS  NOE 

— 

1 

ATWT  = 

10.01 

5  B 

EOGE  1 

1  . OOOOOE 

0 

5  B 

CQEF1 

9.95057E 

0 . -2 . 74 1 73E 

0 

.-2 

. 15138E 

-1.  2.27045E  -2 

5  B 

1 

T ITANIUM 

X-RAY  ABS  NOE 

s 

2 

ATWT  = 

47.90 

22 

T  I 

EOGE  1 

1  .OOOOOE 

0.  4 • 9650  0  E 

0 

22 

T  I 

C0EF1 

1  • 3 1 C  74 E 

1  . —  2 • 5  360 1 E 

0 

.-9 

•37662E 

-2.-3.07696E  -4 

22 

T  I 

C0EF2 

1  .43509E 

1  .-1  . 6636  1  E 

0 

.-3 

•  31 403E 

-1.  2.61935E  -2 

22 

T  1 

VANADIUM 

X-RAY  ABS  NOE 

— 

2 

ATWT  = 

50.94 

23 

V 

EOGE  1 

1  .OOOOOE 

0  .  5.4  6500  E 

0 

23 

V 

COEF  1 

1 • 32515E 

1 .— 2.49745E 

0 

.-1 

• 06643E 

-1  .  7 .70206E  -5 

23 

V 

C0EF2 

1  • 4  7  590  E 

1 .-1 .08849E 

0 

.-2 

.7 1 904E 

-  1  .  2.15  02  4E  -  2 

23 

V 

CHROM 1UM 

X-RAY  ABS  NOE 

— 

2 

ATWT  = 

52.00 

24 

CR 

EOGE  1 

1 .OOOOOE 

0.  5.98900E 

0 

24 

CR 

COEF  1 

1 . 34235E 

1  .-2. 5 1606E 

0 

.-l 

•  0  1  138E 

-1  . -2 .3609  0E  -4 

24 

CR 

C0EF2 

1 .400 15E 

1 .- 1 .02384E 

0 

.-  2 

. 79236E 

-  1 .  2. 1 741 9E  -2 

24 

CR 

MANGANESE 

X-RAY  ABS  NOE 

s 

2 

ATWT  = 

54  .94 

25 

MN 

EOGE  1 

1  .OOOOOE 

0.  6.54000E 

0 

25 

MN 

C0EF1 

1 .35761 E 

1 .-2 .49626E 

0 

.-1 

.0  7026E 

-1  .  6  .2003  IE  -4 

25 

MN 

C0EF2 

1 .40969E 

1  . -  1 . 79094E 

0 

.-2 

. 8364  OE 

-1  .  2 .22  096 E  -2 

25 

MN 

IRON 

X-RAY  ABS  NOE 

— 

2 

ATWT  = 

55.05 

26 

FE 

EDGE  1 

1 .OOOOOE 

0.  7.11200E 

0 

26 

FE 

COEF  1 

I • 36697E 

1  •  —  2 • 39272  E 

0 

.-  I 

•  3  67  95E 

—  1  .—  2.3721 2E  -4 

26 

FE 

COEF  2 

1  .43458E 

1 .-1 .2351 2E 

0 

.-4 

• 10728E 

-1 .  3.2  1 61 4  E  -2 

26 

FE 

NICKEL 

X-RAY  ABS  NOE 

= 

3 

ATWT  = 

58.7  1 

20 

N  1 

EOGE  I 

1 • OOOOOE 

0.  1.012  0  OE 

0 

•  8 

.  33300E 

0 

20 

Nl 

COEFI 

1 .30363E 

1  .  —  2.4774  OE 

0 

. 

.OOOOOE 

0.  .OOOOOE  0 

20 

N  I 

C0EF2 

I  • 39049E 

I .-2.48097E 

0 

.-0 

•  00  2  92  E 

-2.  3.18989E  -5 

20 

NI 

C0EF3 

1 .42375E 

I .-9.66762E 

- 1 

.-4 

• 70299E 

-1.  3.66306E  -2 

20 

Nl 

COPPER 

X-RAY  ABS  NOE 

- 

3 

ATWT  = 

63.54 

29 

CU 

EOGE  I 

I  .OOOOOE 

0.  I.IOOOOE 

0 

•  0 

. 97900E 

0 

29 

cu 

COEFI 

I  •  40954E 

I  •  —  2 • 5 903 9E 

0 

• 

•OOOOOE 

0.  .OOOOOE  0 

29 

CU 

C0EF2 

I • 42  443E 

1 .— 2.50031E 

0 

.-6 

•5I996E 

—  2  •— 4  •  I  302 5 E  -4 

29 

cu 

C0EF3 

I .450O7E 

l.-l. I0359E 

0 

.-4 

. 1 3099E 

-1.  3.I2I29E  -2 

29 

cu 

ZINC 

X-RAY  ABS  NOE 

m 

5 

ATWT  = 

65*37 

30 

ZN 

EOGE  I 

1  .OOOOOE 

0.  1.02100E 

0 

•  I 

•0440 OE 

0.  1 • I 960  OE  0 

30 

ZN 

EOGE  2 

9.65900E 

0 

30 

ZN 

COEFI 

I  .2  059  9E 

0.-1 • 12290E 

0 

. 

•OOOOOE 

0*  .OOOOOE  0 

30 

ZN 

C0EF2 

1 .3S301E 

I .-2.62547E 

0 

» 

•OOOOOE 

0.  .OOOOOE  0 

30 

ZN 

COEF  3 

1.41741E 

1 .  —  2 • 631 24E 

0 

# 

•OOOOOE 

0.  • OOOOOE  0 

30 

ZN 

C0EF4 

1 .43226C 

1 .  —  2 • 62555E 

0 

.-2 

•SOI 90E 

-2.— 3. 53392E  -4 

30 

ZN 

COEF  5 

1 .44132E 

1 .-9.34286E 

-1 

•  -4 

• 77 04 BE 

-1 .  3 •625B9E  -2 

30 

ZN 

FIGURE  C.2  DATA  BANK  CONTAINING  X-RAY  ABSORPTION  DATA  FOR  SEVERAL 
ELEMENTS  (ON  TAPE  2) 


113 


dose  profiles  are  all  contained  on  Tape  4.  Only  x-ray  absorption  data 
are  on  Tape  2.  The  two  banks  are  used  so  that  GENRAT  can  read  properties 
from  Tape  4  and  then  be  referred  to  Tape  2  to  pick  up  absorption 
characteristics  without  losing  its  position  in  Tape  4. 

The  data  banks  in  Figures  C.l  and  C.2  contain  a  series  of  separate 
data  groups.  Each  group  is  constructed  strictly  in  accordance  with  the 
requirements  of  GENRAT.  However,  the  groups  themselves  may  be  in  any 
order  and  may  be  spaced  by  blanks  or  comment  cards  to  annotate  the  bank. 

The  data  banks  may  be  constructed  by  placing  card  images  on  a  file 
before  the  PUFF  calculation  or  by  letting  GENRAT  write  the  file  during 
the  calculation  as  in  the  preceding  examples.  We  have  stored  large  data 
banks  on  an  UPDATE  file  and  written  the  data  bank  from  UPDATE  as  a 
COMPILE  file.  Alternatively,  the  bank  may  be  written  by  copying  cards 
to  the  appropriate  file  using  control  cards. 

The  banks  are  used  in  the  following  way.  The  data  deck  is  constructed 
in  the  normal  way  except  that  the  information  in  the  bank  is  omitted. 
Instead,  some  indicator  is  provided  to  show  where  the  data  should  be 
found.  Figure  C.3  shows  a  data  deck  for  an  impact  with  a  hot  aluminum 
target.  The  "XM  in  the  first  column  of  the  IDENT  card  shows  that  the 
remainder  of  the  general  running  data  should  come  from  the  data  bank  and 
that  the  NAMELIST  routine  EXTRA  should  be  called.  The  letters  "SHOCKEY" 
in  columns  72-80  give  the  title  of  the  set  of  general  running  data  to 
be  used.  These  letters  correspond  to  those  in  column  12-20  following 
"HEADING"  in  Figure  C.l.  After  GENRAT  reads  the  general  running  informa¬ 
tion,  it  reads  the  "EXTRA"  card  and  calls  EXTRA  to  read  the  "$NLIST..." 
line.  The  end-of-file  (7/8/9)  stops  the  reading  in  EXTRA.  The  nT"  in 
the  first  column  of  the  material  cards  for  1145  aluminum  show  that  the 
properties  for  these  materials  must  come  from  the  data  bank. 

In  GENRAT  the  input  deck  of  Figure  C.3  is  used  to  construct  a  com¬ 
plete  data  deck.  The  GENRAT  output  for  this  case  is  in  Figure  C.4.  The 
indicators  to  the  right  of  the  card  images  help  to  show  the  process. 

The  variable  IND  is  the  indicator  in  the  first  column.  IN  is  the  file 
from  which  the  line  is  taken:  IN  =  5  shows  the  standard  input  file, 
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whereas  IN  -  4  indicates  Tape  4,  the  data  bank.  Hence  in  this  case  the 
first  line  is  from  the  data  deck.  Next  the  data  bank  is  searched 
(by  the  subroutine  REDR)  for  a  label  HEADING  SHOCKEY .  Then  GENRAT  reads 
the  next  four  lines  from  the  data  bank.  Control  then  returns  to  the 
data  bank  and  the  subroutine  EXTRA  is  called  to  read  and  print  the 
NAMELIST  data  which  reinitializes  the  flyer  velocity  to  1.46  x  10^  cm/sec. 
Then  GENRAT  reads  the  line  T1145-AL,  which  causes  REDR  to  find  the 
appropriate  line  in  the  data  bank  again.  GENRAT  repeats  the  reading  of 
the  material  name  card  and  then  reads  the  remaining  properties  from  the 
data  bank.  After  the  two  sets  of  aluminum  data,  control  returns  to  the 
data  deck  for  reading  the  cell  layout  and  the  second  NAMELIST  record. 

A  second  example  of  the  use  of  data  banks  is  shown  in  Figures  C.5 
and  C.6.  The  data  deck  in  Figure  C.5(a)  describes  a  radiation  problem 
using  a  spectrum  labeled  SPEC__Z12,  which  deposites  energy  into  three 
materials:  asbestos  phenolic  (AP),  fused  silica,  and  quartz.  The  "T" 
in  the  first  column  indicates  which  data  are  taken  from  Tape  4.  The 
material  property  data  for  AP  are  also  shown  as  part  of  a  data  bank  in 
Figure  C.5(b).  The  completed  input  deck  constructed  by  GENRAT  and 
exhibited  in  Figure  C.6  shows  the  source  for  each  line  in  the  column  on 
the  right  labelled  "IN".  IN  =  5  is  the  normal  input  file  shown  in 
Figure  C.5(a);  IN  =  4  means  Tape  4  and  IN  =  2  means  Tape  2.  The  line 
headed  "TAP11  in  the  deck  in  Figure  C.5(a)  brings  in  the  properties  from 
Tape  4  shown  in  the  data  bank  of  Figure  C.5(a).  Included  in  these 
properties  are  the  chemical  constituent  data  needed  for  the  x-ray 
absorption  calculation  and  read  in  the  subroutine  DEPOS .  The  constituent 
data  names  the  chemical  species  (e.g.,  IRON),  the  source  of  the  absorp¬ 
tion  data  (e.g.,  ITAPE  =  2),  and  the  weight  fraction  (PBW) .  The  IRON 
is  located  by  REDR  on  Tape  2,  and  DEPOS  reads  the  number  of  edges  (NOE), 

atomic  weight  (ATWT) ,  the  EDGES,  and  the  COEFS  (A  ,  A, ,  Art,  and  A 

o  1  2  3 

referred  to  in  Appendix  A).  The  same  process  is  repeated  for  silica  and 
quartz,  except  that  PBW  is  interpreted  as  the  number  of  atoms  of  the 
constituent  in  the  modecule,  instead  of  the  weight  fraction  (because 
PBW  >  1.0). 
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T  1DENT  AP  EXPERIMENT  H  3118  X-RAY  DEPOSITION  INTO  A  HEAT  SHIELD  APOS 
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( GRAHAM ) 

NL  AYE  R 

= 

3 

J  M  AT  = 

1  2 

3 

nzones= 

1 

103 

CELLS 

1  N 

3. 550E- Cl 

CM  DX  = 

1.000E-04  RATIO  = 

1  . 05  EO 

N Z ONES= 

1 

1  3 

CELLS 

IN 

6. 350  E- C 1 

CM 

N L ONE  S  = 

1 

1  6 

CELLS 

1  N 

8. 000E-C1 

CM 

NS  PEC  = 

1 

ANGLE 

— 

0  . 

T  SPEC  l 12  NHNU  = 

0 

ecal  = 

1  .  1  00  E  0  2 

START  - 

0.  SS  TOP  = 

5  •  0  0  0  E 

7/8/9 

(a)  SAMPLE  DATA  DECK  FOR  RADIATION  PROBLEM 
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(b)  SAMPLE  PROPERTY  DATA  FOR  AP  IN  DATA  BANK  ON  TAPE  4 


FIGURE  C.5  DATA  DECK  AND  DATA  BANK,  ILLUSTRATING  USE  OF  DATA  BANKS  FOR 
RADIATION  PROBLEMS  WITH  MULTICONSTITUENT  MATERIALS 
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FIGURE  C.6  INPUT  CONSTRUCTED  BY  GENRAT  FOR  RADIATION  PROBLEM  IN  WHICH  GENERAL  RUNNING  INFORMATION, 
MATERIAL  PROPERTIES,  RADIATION  ABSORPTION  DATA,  AND  SPECTRUM  ARE  ON  DATA  BANKS 
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FIGURE  C.6  INPUT  CONSTRUCTED  BY  GENRAT  FOR  RADIATION  PROBLEM  IN  WHICH  GENERAL  RUNNING  INFORMATION, 
MATERIAL  PROPERTIES,  RADIATION  ABSORPTION  DATA,  AND  SPECTRUM  ARE  ON  DATA  BANKS  (Concluded) 


Additional  Input:  EXTRA  and  H-DATA 


Occasionally  it  is  necessary  to  insert  additional  information  for 
which  there  is  no  standard  reading  procedure.  In  that  case  the  EXTRA 
routine  is  called  to  read  the  information  through  a  NAMELIST  READ 
statement,  or  HDATA  is  called  to  read  variables  into  the  H  array.  The 
use  of  EXTRA  is  considered  first. 

In  the  special  NAMELIST  READ  statement  in  EXTRA,  the  variable  and 

its  value  are  given.  The  sample  shown  at  the  end  of  Figure  C.4  is 

$NLIST  EHL( 12)  =  20*4. 46E9,  RHOS(2)  =  2.784$.  The  dollar  sign  in  column 

2  and  at  the  end  delimit  the  information  and  also  signal  a  NAMELIST  READ. 

The  list  of  variables  used  in  EXTRA  is  called  NLIST:  it  includes  most 

of  the  material  properties,  the  main  cell  arrays,  indicators,  and  other 

variables  for  which  a  change  might  be  required.  The  effect  of  the  READ 

statement  mentioned  above  is  to  initialize  20  values  of  EHL ,  the  internal 

9 

energy,  beginning  at  EHL(12)  with  a  value  of  4.46  x  10  and  then  reset 
the  initial  density,  RHOS,  of  the  second  material  to  2.784.  This  case 
illustrates  two  uses  of  EXTRA:  the  EHL  array  is  being  initialized  to 
represent  a  preheating  of  the  target,  and  RHOS  is  being  reset.  RHOS  was 
initialized  to  2.705  in  the  normal  way  with  the  material  property  data. 
That  value  is  appropriate  for  preheated  and  expanded  aluminum  and  is 
needed  for  giving  the  cells  the  correct  initial  mass  and  density. 

However,  for  the  equation-of-state  calculations,  the  standard  density 
of  2.784  is  required;  this  resetting  is  accomplished  after  the  layout 
by  means  of  the  EXTRA  routine  as  shown. 

Pressure  boundary  information  may  be  inserted  through  the  NAMELIST 
READ  as  shown  in  Figure  C.5.  The  parameters  P6  and  T6  define  a  pressure 
history  with  the  form 

P  =  P6  exp  (t/T6) 

Subscripts  (1)  for  P6  and  T6  indicate  the  first  boundary,  whereas  (2) 
indicates  the  final  boundary. 
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CALLS  to  EXTRA  may  occur  at  two  points  in  GENRAT:  immediately 
following  the  general  running  information  and  at  the  end  of  the  deck. 

As  mentioned  above,  the  first  of  these  CALLS  is  triggered  by  an  "Xn  in 
the  first  column  of  the  IDENT  line.  The  second  CALL  is  caused  by  a 
line  with  the  letters  "_EXTRA"  preceding  the  lines  containing  the 
NAMELIST  data. 

The  NAMELIST  statement  does  not  permit  the  use  of  alpha  or  octal 
data.  Therefore,  to  initialize  the  H  parameter  array,  it  was  necessary 
to  construct  a  special  reading  subroutine,  HDATA .  HDATA  is  called  only 
at  the  end  of  the  data  deck.  If  both  EXTRA  and  HDATA  are  used,  HDATA 
must  precede.  The  data  line  for  HDATA  is  preceded  by  a  line  containing 
the  label  M_H-DATAn.  HDATA  reads  only  1  or  2  H  values  for  each  call, 
but  multiple  calls  are  possible  by  providing  additional  n__H-DATA"  and 
data  lines.  The  data  are  in  a  single  line  containing,  J,  I,  and  K  for 
the  equation  H(J,I)  =  K,  and  K  is  read  in  an  R5  format.  In  our  work 
the  only  H  values  reset  with  HDATA  have  been  at  first  or  last  coordinates 
to  change  boundary  conditions;  therefore,  not  more  than  two  values  were 
required . 

Input  Description  for  Historical  Prints 

Historical  listings  can  be  obtained  for  any  variable  in  the  cell  or 
coordinate  arrays  and  for  several  other  variables.  This  section  describes 
the  input  data  required  to  obtain  the  histories,  and  the  subroutines  used. 

Input  Directives.  Each  input  directive  for  a  historical  listing  consists 
of  two  groups  of  symbols:  one  part  is  for  the  type  of  data  and  one  part 
is  for  the  location  in  the  material.  The  directives  are  provided  in 
free-field  format  in  columns  11  to  80  of  a  data  line.  Samples  of  these 
directives  are 

SI, 26  D, 18  C0M1 ,  3.25 

In  each  of  these  three  pairs,  the  characters  before  the  comma  are  a 
directive  group  that  designates  a  data  type:  SI  is  thermodynamic  stress 
in  the  direction  of  propagation,  D  is  density,  and  C0M1  is  the  first 
variable  assigned  to  the  COM  array,  a  large  array  available  for  use  with 
constitutive  relations  that  require  extra  storage.  All  these  type 
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designators  are  defined  in  Table  C.l.  The  number  after  the  comma  are 
a  directive  group  that  designates  a  location  within  the  material.  For 
example,  26  and  18  are  cell  numbers.  The  decimal  3.25  means  layer  3, 

25%  of  the  distance  from  the  front  of  the  layer.  The  groups  of  characters 
forming  a  directive  group  are  separated  by  either  commas  or  blanks. 

More  samples  of  the  directives  are  given  in  Table  C.2.  The  first 
10  spaces  of  each  line  may  be  used  to  identify  the  line  or  may  be  left 
blank.  The  next  70  characters  contain  the  designators  that  are  processed 
to  determine  which  stress  histories  are  required.  Table  C.2  shows 
several  sets  of  directive  groups.  Each  set  begins  with  one  or  more  type 
designator  groups  (beginning  with  a  letter)  and  ends  with  one  or  more 
numerical  groups.  A  set  constitutes  a  request  for  histories  of  all  the 
types  given  by  type  designators  at  each  of  the  locations  in  the  numerical 
groups . 

The  first  line  of  the  table  contains  five  numbers  that  constitute 
a  set  requesting  stress  histories  in  the  direction  of  propagation  at 
those  cell  locations.  In  this  case  a  type  designator  was  omitted: 

SI  is  assumed  to  be  the  type  if  the  first  character  on  the  first  line 
is  an  integer.  The  next  type  designator  is  D  for  density,  followed  by 
three  cell  locations  for  which  density  histories  are  required.  On  the 
second  line  is  a  large  set  containing  five  type  designators:  SI,  S2, 

S3,  E,  and  Y.  Hence  first,  second,  and  third  principal  stresses,  internal 
energy,  and  yield  strength  are  requested  at  cells  6,  7,  and  8.  Next 
the  coordinate  position  X  is  requested  at  coordinate  points  6  and  9. 

The  third  line  shows  a  request  similar  to  that  on  the  second  line, 
except  that  the  second  request  set  (C,  U,  SDl,  24,  30,  35)  is  continued 
on  the  fourth  line.  The  fourth  line  also  contains  a  set  requesting 
histories  of  the  24th  variable  in  the  COM  array  for  cells  5,  10,  15, 
and  20. 

In  addition  to  the  requested  histories  is  a  group  of  histories  that 
are  automatically  obtained.  The  time  increment  (DTNH),  the  calculation 
time  for  each  time  step  (DELTIM) ,  and  the  cell  controlling  the  time 
step  ( JTS )  are  always  given.  In  a  multilayer  problem,  interface  stress 
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Table  C. 1 


DEFINITIONS  OF  DIRECTIVE  GROUPS 

c 

Sound  speed,  cm/ sec 

COM, 

COM2, 

COM12 

An  array  containing  special  variables  used  by  constitutive 
relations  that  require  more  than  the  standard  arrays.  A 
number  immediately  following  COM  indicates  the  particular 
one  of  these  special  variables  requested. 

D 

.  ,  3 

Density,  g/cm 

DPDD 

3P/3p,  dyn/cm^/ (g/cm^) 

DPDE 

3P/3E,  dyn/cm2/ (erg/g) 

E 

Internal  energy,  erg/g 

HI 

H(J,1),  cell  state  indicator 

H2 

H(J,2),  cell  or  coordinate  type  indicator 

H3 

H(J,3),  cell  state  indicator 

IMP 

Impulse  =  J Rdt,  dyn-sec/cm2 

NEM, 

NET 

Special  arrays;  meaning  depends  on  the  material  model 

P 

Pressure,  dyn/cm2 

R 

2 

Mechanical  stress  in  direction  of  propagation,  dyn/cm 

SDT 

Deviator  stress  in  the  circumferential  direction  in 
cylindrical  problems,  dyn/cmz 

SD1,  SD2 , 
SD3 

Deviator  stresses  in  the  direction  of  propagation,  and  in 
two  orthogonal  directions.  For  cylindrical  geometry,  the 
second^direc tion  is  circumferential  and  the  third  is  axial, 
dyn/cm 

SI,  S2 , 

S3 

Principal  stress  in  the  direction  of  propagation  and  in  two 
orthogonal  directions.  For  cylindrical  geometry,  the  second 
direction  is  circumferential  and  the  third  is  axial,  dyn/cm^ 

S-INT 

Interface  stress — average^of  stresses  in  cells  on  either 
side  of  interface,  dyn/cm 
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Table  C.l  (concluded) 


T 

U 

V 

X 


2 

Spall  strength ,  dyn/cm 

Coordinate  velocity,  cm/sec 

.  .  3 

Specific  volume,  cm  /g 

Coordinate  location,  cm 


XO  Initial  coordinate  location,  cm 

2 

Y  Yield  strength,  dyn/cm 

2 

Z  Cell  mass,  g/cm  ,  g/cm,  or  g  for  planar,  cylindrical 

and  spherical  geometries,  respectively 


1,2, any  Cell  or  coordinate  number 

integer 


3.25  Location  designator.  Integer  before  the  decimal  indicates 

the  layer  number  (not  counting  void  layers).  The  following 
number,  including  the  decimal,  is  the  fractional  distance 
into  the  layer 
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Table  C.2 


SAMPLE  INPUT  DIRECTIVES 

1  10  11  80 


JEDIT  = 

16  23  4 

29  18 

D  , 8 , 9, 1 1 

JED IT  2 

SI, S2,S3,E,Y, 

00 

X,  6 ,  9 

HIST  3 

U,  H2 , NEM , 16 

c,u, 

SDl 

24 

4th  CARD 

30,35,COM24 

5  10 

15 

20 

Column  numbers  on  an  input  card;  first  column  should  be  left  blank. 
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histories  are  listed  between  each  layer.  With  the  current  dimensions, 
a  total  of  100  histories  may  be  printed. 

Subroutine  Description.  Three  subroutines,  PRESCR,  STORR  and  SCRIBE, 
process  the  input  directives,  store  the  required  cell  information  during 
the  wave  propagation  calculation,  and  print  the  histories  at  the  end 
of  the  calculation.  Here  only  an  outline  of  the  procedure  is  given. 

During  the  initialization  stage  of  a  computation,  the  input  directives 
are  read  by  GENRAT.  At  the  end  of  GENRAT,  PRESCR  (meaning  PRE-SCRIBE) 
is  called.  PRESCR  examines  the  input  directives  character  by  character 
and  constructs  three  arrays:  JTYP ,  JEDIT,  and  JNUM.  JTYP  contains  the 
title  of  the  history,  including  the  data  type  and  cell  location.  JEDIT 
is  the  j  value  of  the  cell,  and  JNUM  is  the  location  of  the  specific 
variable  in  the  coordinate  arrays. 

At  each  time  step  during  a  wave  propagation  calculation,  STORR  is 
called  to  store  all  the  requested  variable  values  from  that  time  step. 

The  JNUM  and  JEDIT  arrays  are  used  to  select  the  correct  values  for 
storage.  Temporarily  these  values  are  stored  in  the  A  array.  When 
part  of  the  A  array  is  filled,  the  values  are  buffered  out  to  a  disk 
file  (called  Tape  3)  while  the  second  part  of  the  array  is  being  filled. 
When  the  second  part  is  full,  storage  begins  again  in  the  first  part 
and  the  second  part  is  buffered  out.  This  process  is  repeated  throughout 
the  calculation. 

At  the  end  of  the  wave  propagation  calculation,  STORR  is  called  to 
complete  buffering  of  information  to  the  disk  file.  Then  SCRIBE  is 
called  to  print  the  histories.  SCRIBE  reads  the  disk  file  and  prints 
10  histories  at  a  time.  When  one  set  of  histories  is  complete,  SCRIBE 
rewinds  and  rereads  the  file  and  prints  another  set  until  all  the 
histories  have  been  listed. 
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Additional  Variables  for  Material  Models:  COM,  LVAR,  NVAR 


An  array  of  additional  variables  is  provided  for  use  with  material 
models  requiring  more  variables  per  cell  than  normally  available.  These 
extra  variables  are  in  the  COM  array.  This  section  describes  the  use 
of  the  array,  when  it  is  needed,  how  to  use  it  when  adding  new  material 
models,  and  how  to  obtain  historical  listings  of  values  in  the  array. 

The  usual  variables  available  at  each  cell  for  each  material  model 

are  those  in  the  COMMON  labeled  COORD.  Included  are  the  yield  array 

YHL,  the  quantities  NEM  and  NET,  and  an  indicator  H(J,I).  For  material 

models  where  these  variables  are  insufficient,  the  COM  array  is  provided. 

So  far,  the  following  subroutines  have  required  this  extra  storage: 

BFRACT2  (11  variables),  BFRACT3  (20,  HYPO  (3),  PEST  (5),  REBAR  (7),  and 

SHEAR2  (indefinite  number).  The  number  required  for  SHEAR2  is  4  +  NANG 

+  2£  NSIZE.,  where  NANG  and  NSIZE.  are  input  data  for  SHEAR2 . 
i  1  1 

Locations  within  COM  are  assigned  with  the  aid  of  a  second.  array 
LVAR(J).  LVAR(J)  is  the  location  in  COM  at  which  the  storage  for  the 
jth  cell  begins.  Then,  for  example,  the  fifth  value  in  COM  for  the  j th 
cell  is  C0M(L+4)  where  L  =  LVAR(j).  NVAR(M)  (an  input  quantity)  is  the 
number  of  additional  variables  assigned  to  each  cell.  The  location 
quantities  LVAR  may  be  assigned  during  the  initialization  of  the  problem 
or  during  the  running.  For  the  fracture  routines  BFRACT2  and  BFRACT3 , 
the  assignment  is  made  for  the  jth  cell  during  the  computation  at  the 
time  fracture  begins  at  that  cell.  Hence,  if  the  cell  never  undergoes 
fracture,  it  does  not  require  the  added  storage. 

The  COM  array  is  especially  convenient  for  providing  variables  to 
new  models  because  the  formal  parameters  of  the  model  subroutine  may  be 
either  scalars  or  arrays.  For  example,  BFRACT2  has  the  formal  parameters 
FU2D,  CL,  and  CN,  where  FU2D  is  a  scalar  and  CL  and  CN  are  each  arrays 
of  five  quantities.  In  the  CALL  statement  these  same  parameters  are 
listed  as  COM(L),  C0M(L+1),  and  C0M(L+6) . 
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Historical  listings  can  be  obtained  of  all  array  quantities, 
including  COM  array  quantities.  The  form  of  the  request  for  the  listing 
is  UC0M2  or  "COMll".  In  the  sample  of  the  preceding  paragraph,  COM2 
would  indicate  the  second  value  in  the  COM  array  for  the  particular  cell, 
and  that  corresponds  to  CL(1)  in  the  CALL  to  BFRACT2 .  Similarly,  COMll 

* 

refers  to  CN(5).  Usually  the  CALL  statements  in  HSTRESS  must  be  compared 
with  the  formal  parameters  of  the  material  model  to  relate  the  COM 

quantities  to  the  variables  of  interest. *  * 

Sample  Data  Decks 

A  number  of  sample  data  decks  are  provided  to  illustrate  the  main 
features  of  PUFF  and  the  range  of  problems  that  can  be  treated.  General 
guide  lines  for  constructing  the  decks  are  listed  below. 

•  The  data  fields  are  usually  in  multiples  of  5  or  10 
characters . 

•  The  first  column  is  reserved  for  indicators. 

•  Columns  2  through  10  are  usually  labels  only. 

•  Any  number  of  decks  can  be  run,  one  following  the 
next  with  only  an  end-of-file  (7/8/9)  between  decks. 

These  features  are  illustrated  in  the  following  sample  decks. 

The  data  decks  are  grouped  according  to  problem  type,  but  each 
also  illustrates  many  other  features.  Figures  C.7  through  C.10  (and 
Figure  C. 3) show  impacts  in  planar  geometry,  Figures  C . 11  through  C . 13 
are  for  cylindrical  geometry,  and  Figure  C . 14  is  for  spherical  geometry. 

Explosives  are  featured  in  Figures  C . 15  and  C.16  and  radiation  in 
Figures  C . 17  through  C . 20  (and  Figure  C.5).  A  pressure  boundary  provides 
the  loadings  in  Figures  C.21  and  C.22. 

The  JEDITS  are  listed  in  several  ways.  Many  are  integers  without 
TYPE  designation,  indicating  that  only  a  is  required.  In  Figure  C.ll, 
all  three  prinicpal  stresses  and  C0M(3)  are  required  at  positions  given 
by  decimals  such  as  2.1  (2.1  means  a  location  in  layer  2,  0.1  times  the 
thickness  through  the  layer). 


128 


1DENT  847 

I  FRACTURE  IN  1145  - 

*L.  FRACTURE  IMPACT 

EXPERIMENT 

AT  423 

F T/SEC 

NE01T  = 

0 

NJE01T  * 

2 

JED  ITS  = 

27  28 

29  30 

3  1 

32 

15  16 

17  18 

19 

20 

21  22 

23  24 

25  26 

NED  1  T  = 

20 

JCYCS  = 

l  eo 

CKS  = 

3.  0 

TS  = 

3.000E-06 

NMTRLS  - 

2 

MATFL  - 

1 

U  ZERO  = 

1  .289E  +  04 

AL  1145 

RHUS  - 

2.7E0 

CFP  s  000 

DP Y  =  003 

NC  ON  =  0 

EQST  * 

7.60CE+1 1 

1  .500E+1 2 

1 .220E+1 1 

2 .0  4E  0 

0 . 2  5E  0 

0. 

TENS  = 

- 1 • OOOE+1 1 

0  • 

-1  .EO 

vise  = 

4  .EC 

0  .0  5E0 

0. 

YIELD  = 

2 . 00  OE  +  0  9 

3.000E+1 1 

0  • 

AL  1145  FW 

RHOS  = 

2. 7E0 

CFP  =  010 

DP Y  =  003 

NCUN  =  C 

EQST  = 

7.600E+1 1 

1  . 50  OE ♦ 1 2 

1  • 2  20  E  +  1  1 

2.04E0 

0 .25E0 

0. 

DFR1  1145- 

-0.01  -4.00CE+09 

1 .OOOE- 

04 

3 • 000E+09 

-3.000E  09- 

-4 .000E  +  08 

TENS  = 

-1 .20CE+10 

0. 

VI  SC  = 

4  •  E  0 

0 . 05 EO 

0. 

yield  = 

2 .000E+09 

3 • 0  0  OE ♦ 1 1 

0. 

NL  A  YE  R  = 

2 

JM  AT  = 

1 

2 

NZQNES^  1 

10 

CELLS  IN 

C.  2 36 

CM 

NZONcS=  1 

25 

CELLS  IN 

0.635 

CM 

78/9 

FIGURE 

C.7  INPUT 

DECK  FOR 

IMPACT 

IN 

1145  ALUMINUM,  ILLUSTRATING 

DUCTILE 

FRACTURE  DATA 

AND  JEDITS  WITH  NO  TYPE  INDICATOR 

129 


1 DENT  =  S25  E  SHOT 
C  STANDARD  IMPACT 
C  MODELS 


8b7  8— 1 - S25 
SI MULAT I  ON 


IN  ARMCO  I RUN 

USE D  TO  CALIBRATE  OR  CHECK  BRITTLE  FRACTURE 


20 


NTEOT  = 

0 

NJED  1T  = 

2 

NREZON= 

0 

JED1T  - 

27  28 

29  30 

3 1  32 

33  34 

38  39 

16  18 

23  24 

25  26 

NED  IT  = 

I  0 

JCYCS  = 

I  50 

CKS  = 

3  .0 

TS  = 

NMTRLS  = 

2 

matfl  = 

1 

UZEPG  = 

1 . 960E+04 

ARMCO  IRON 

RHOS  = 

7.85 

CFP  -  020 

DP  Y  =  001 

EQ  ST  = 

1 

• 569E  + 1 2 

5. I  7CE+  I  2 

7.360E+ 10 

1 .690E+00 

2.500  E- C I 

5. 1 70E+1 3 

TSRI  = 

-5 

• 500E-04- 

■I  .000E  *00 

5.000E-05 

4. 000E+I 2- 

■3.000E+09- 

•5 .270E  +  09 

TSR2  = 

0 

• 

0. 

2.500E-01 

5.000E-0I 

4.000E-0I 

3  .OCOE  +  OO 

YO  = 

2 

•O00E+09 

8. 1 90E  + I I 

PMMA-8KB 
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FIGURE  C.8  INPUT  DECK  FOR  IMPACT  IN  ARMCO  IRON,  ILLUSTRATING  BRITTLE 
FRACTURE  AND  A  GEOMETRIC  CELL  LAYOUT 
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1DENT  =  103A  SYMMETRIC  IMPACT  OF  TONAL 1TE «  COULOMB  FRICTION  AND  POROSITY 


N  TED  T  - 
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N JED  1 T  = 

1 

0 
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JED1TS  = 

1  1  1 
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NED  IT  - 

50 

JCYCS  = 
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CKS  = 
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TS  a 
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1 

MATFL  = 

-1 

U  ZERO  = 

6.320E+04 

C  C  TONALITE 

RHOS  = 
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CFP  =  CO  1 
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NCON  =  C 

EQ  ST  = 

2.94CE+1 1 

3.056E+1 2 
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RHO  = 

2.56E0 
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MU  P  = 
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FIGURE  C.9  INPUT  DECK  FOR  ASYMMETRIC  IMPACT  OF  TONALITE,  SHOWING  COULOMB 
FRICTION  WITH  TAN0  =  0.056,  MULTIPLE  ZONES  IN  LAYER,  AND  USE  OF 
THE  POREQST  MODEL 
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I  DENT  PROJECTILE  IMPACT  ON  CONCRETE  AT 

22. 24M/SEC 
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CFP- 
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FIGURE  C.10  INPUT  DECK  FOR  IMPACT  OF  A  STEEL  PLATE  ONTO  REINFORCED 
CONCRETE,  SHOWING  THE  USE  OF  CAP  AND  REBAR  SUBROUTINES 
AND  MULTIPLE  LAYERS  OF  A  SINGLE  MATERIAL 
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IOENT  FR  5  FRAG  ROUND  OF  ARMCQ  IRON  TO  SIMULATE  CROWES  TESTS  3  AND  4 
C  THE  COMP  B  EXPLOSIVE  IS  TREATEO  BY  A  SIMULTANEOUS  OETONAT ION 
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I  • 69E  0 

0. 25E0 

5. 1 70EF1 3 

SH2 

3.000E+01 

•  2  0  0  OE  +  0  0 
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FIGURE  C.11  INPUT  DECK  FOR  THE  CYLINDRICAL  CALCULATION  OF  A  FRAGMENTING 
ROUND,  SHOWING  DETONATION  OF  AN  EXPLOSIVE,  SHEAR  BAND  MODEL, 
AND  ENGLISH  UNITS  IN  THE  LAYOUT 
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IDENT  FR 

4  FRAGMTG 

RNO  OF  HF- 

1  TO  SIMLLATE  CROWES 

TESTS  1  AND  2. 

NT  EOT  = 

0 

NJ  EDIT  = 
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FIGURE  C.12  INPUT  DECK  FOR  THE  CYLINDRICAL  CALCULATION  OF  A  FRAGMENTING 
ROUND  OF  HF1  STEEL,  SHOWING  DETONATION  OF  AN  EXPLOSIVE 
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CYLINDRICAL  PUFF  CALC  OF  C ONC RE TE /GRO U T 

FOR  KECUGH 

ON  6172- 

1  0 

NTEDT  - 
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NJEDT  =  1 
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0 
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0 
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CKS  = 
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2 
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U  ZERO 

=  0 

• 
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CFP  = 

001  DP  Y  =  001 

EQ  ST  = 

2 .830E+1 1 

0  •  1  •  000E+  1  1 

2  • 

0 
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0. 

RHO  = 

2.22 

AK  = 
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M  UP  =  5  •  2  5  OE  10 

YO  = 

2 

• 420E+08 

NR  EG  = 

4 

RHOP  = 

2.22 

2.247  2.299 
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2 

•  77  S 

2 . 8 

PI  = 

3.500E+08 

P2  = 

i • oooE+og 

DELP  =  0. 

YAOO  = 

2 

•970E+08 

P2  = 

2 . 40CE+og 

OELP  =  0. 

YADD  = 

2 

. 60OE+O8 

P2  = 
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OELP  =  0. 

YADO  = 

1 

.  220E  +  08 

P2  = 

1 . S33E+1 0 

OELP  =  0. 

YADD  = 

2 

•6g0E+08 

YIELD  = 

0  . 

5.2SCE+10  0. 

0. 

GROUT  (DSR 

M-2  ) 

RHOS  =  2.22C4 

CFP  - 

001  OP Y  =  001 

EQ  ST  = 

8. 83gE+ 1 0 

C.  2.000EM1 

2  • 

0 

.25 

0  . 

RHO  = 

2 . 0668 

AK  = 

8 . 03  S  E  + 1 0 

MU  P  =  2.887E  +  10 

YO 

1 

•  ooo  E+oa 

NR  EG  = 

3 

RHOP  = 

2 .0668 

2.142  2.245 

2. 2S3 

2 

.  353 

2  •  4 

PI  = 

1  .  000E+C8 

P2  = 

3  •  000E+08 

OELP  =  -2.000E+07 

P2  = 

1 • 20CE  +  C  g 

DELP  =  -1 • 200E+08 

P2  = 

4 • OOOE+og 

DELP  =  -2.400E+C8 

YIELD  = 

1 . C00E+08 

3 • 887E+1 0 

NL  AYER  S  = 

3 

JMAT  =  C  1 

2 

NZ  ONE  S  =  1 

0 

CELLS  IN  45. 

CM 

NZ  ONE  S“  1 

s 

CELLS  IN  10. 

CM 

NZCNES=  I 

25 

CELLS  IN  SC. 

CM 

^/a/g 

FUNCTION  SIGMAT(LS.T) 

DIMENSION  PS ( 1 0  )  ,TS(  10  ) 

DATA  PS/O.  .4  .E9 ,4. Eg . 7*0 ./ 

OATA  TS/0..6.E-5.5.0E-4. l.E-3.6*0./ 

DATA  NM/4/ 

N=  1 

S 1 GM  AT  =  C  • 

20  N  =  N ♦ 1 

IF  (N  .GT.  NM)  RETURN 
IF  (T  .GT.  T  S ( N )  )  GO  TO  2C 

SIGMA T=PS(N-1  )+(PS(N)-PS(N-l  )  >  /  <  TS ( N > - TS < N- 1  )  )*( T-TSIN-1  )  ) 

RETURN 

END 


FIGURE  C.13  SIGMAT  AND  INPUT  DECK  FOR  A  CYLINDRICAL  CALCULATION, 
ILLUSTRATING  A  HOLLOW  OR  EMPTY  FIRST  LAYER,  PRESSURE 
BOUNDARY,  AND  USE  OF  POREQST 
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10ENT  -  SPHERICAL  PU FF ♦ / AL 6 0 6 1 T 6/PET N /PMM A /GROUT ( SR  1 R MG- 2C 3 )  -  CAP 

C  A  SPHERICAL  EXPLOSION  WITH  A  CENTAL  BALL  OF  AL,  THEN  A  SHELL  OF  PETN 

C  IN  A  PLASTIC  CONTAINER  IN  A  LARGE  SPHERE  LF  R OCK- M A T CH I NG  GROUT 


NTEOIT  = 

0 

NJED1T  = 

1 

NR  E  ZONE  = 

0 

NALPHA  = 

3 

JEDIT  = 

7  9 

11  13  15  17  19  21 

23  25 

NERIT  = 

1  0 

JCYCS  = 

1  2C 

CKS  = 

1  •  0 0  OE FO  2 

TS  = 

1 . 00CE- 04 

NMTRLS  = 

A 

MATFL  - 

-3 

U  ZERO  - 

0  • 

AL60M  -T6 

RHOS  = 

2. 7C7E0 

CFP  =  000 

DP  Y  =  001 

NON  =  1 

EQ  ST  = 

6. 67  CE  F  1  1 

1  .000E+12 

1  •  2  2  0  E  F  1  1 

2. C40E0 

2 .500E-0 1 

0  • 

0  • 

YIELD  = 

3. 2 1 0EF09 

2 . 670E* 1 1 

3. 7  90E ♦  1  C 

0  • 

0. 

0. 

0  . 

PE  TN  = 

RHOS  - 

1  .EO 

CFP  =  000 

DP  Y  =  063 

EQ  ST  = 

m 

o 

0. 

1  .EO 

1 . 45EC 

1  .  45E0 

0. 

0  . 

I  MAX  - 

21 

RHOP  ~ 

1  .  EO 

0 .501E4-  1  1 

C. 794E0 

0 .300EF 1 1 

0 . 633E0 

0 • 1 83EF 1 1 

0 . 5E0 

0 . 1 1 4E+ 1 1 

0. 398EO 

0 • 725EF 1 0 

0.316EO 

0. 469E  F 1 0 

0. 251 EO 

0  •  3C9EF 10 

0.2E0 

0 .207EF1 0 

0 . 1 59E0 

0 •  1 4CE  F 1 0 

0 .  1 26E  0 

0 • 9  6  7E  F0  9 

0.  1EO 

0. 675EF09 

0 • 794  E -0  1 

0 . 477EF09 

0 .633E-0 1 

0  •  34  1  E  F  0  9 

0 .500E-01 

0 .24  5E  F  0  9 

0. 398E-0  1 

0 •  1 82E  F  09 

0.31 6E-C  1 

0. 1  3  OE  F  0  9 

C.251E-01 

0. 960  E  FO  8 

0.200E-0  1 

0 .71 1 EF08 

0 . 1 56E-0 1 

0 . 5  30E  FO  8 

0 .  126E- 0  1 

0 • 397EF08 

0.  1 C  OE- 0  1 

0. 2  99E  F C d 

TENS  = 

- 1 . 00CE+09 

0  . 

-1  • 0  CO  EF  09 

0  • 

0  • 

0  . 

0  . 

MELT  = 

-1.0C0E0  C 

1  • 

0. 

0  • 

0  . 

0. 

0  . 

VI  SC  = 

4.  EO 

2  .50CE-01 

2 .5CCE-0 1 

0  . 

0  . 

0  . 

0. 

PMMA-BKb 

( HARKfcR ) 

RHOS  = 

1  .  184E0 

CFP  -  0C0 

DP Y  =  0C1 

EQST  = 

7.00CEMC 

4 • 0  50E  F  1  1 

1 . 000EF  10 

1 • 0C0E0 

2.5CCE-0 1 

3. 640EF 1 1 

0  . 

YIELD  = 

1  • 000EF0  t 

1  • 95  OE  F  1  0 

2. 85CEF09 

0  . 

0  . 

0  • 

0  . 

SRIRMG-2C3  GROUT 

RHOS  - 

2. 1 48E0 

CFP  =  004 

DPY  =  002 

EQST  - 

1 . 45CEF 1 1 

0  • 

1  .OCCE  F  1  1 

2.  EC 

2 . 5C0E-0 1 

0  • 

0  • 

RHO  = 

2. 1E0 

AMU- 

9.  0 0 OE F  1  0 

AK  - 

1  • 046E+ 1  1 

AK  2  = 

0. 

MU  P  as 

6. 897EF 1 0 

MUP2  = 

0. 

MC  = 

2. 60CEF08-1 . 000EF08 

1 .321EF09 

1 . OCOEF09 

2  .  EO 

SCR  IT  = 

2 • 300E+OB 

DAMAG  = 

1  . 0  CO  E-03 

EVP  = 

0.  EO 

■4 . 531 E-03 

-6. B06E-03' 

-1 .257E-02 

NR  EG  = 

3 

NPRCAP  = 

0 

PI  = 

■  1 . 000E  F08 

W2  = 

1  .000EF04 

1P2  = 

-. 3200EF09 

OELP  = 

-3.00CEF07 

2P2  - 

-1.1  5CEF  C9 

DELP  = 

F .200CEF09 

3P2  = 

-4 • COC  EF09 

DEL  P  = 

F. 1 30CEF09 

Y  I  EL  D  = 

4 . 345EF  08 

9. 000EF 1 0 

0  • 

0  • 

0  . 

0  • 

0  • 

vise  = 

4  .EO 

2.  50 OE - 0  1 

2.50CE- 01 

0  • 

0. 

0. 

0  • 

NL  AYE  RS  = 

4 

JMAT  - 

1  2 

3  4 

NZ  ONE  S  =  1 

1 

CELLS  IN 

9. 069E-02 

CM 

NZONES=  1 

5 

CELLS  IN 

4. 021E-01 

CM 

NZ  ONE  S=  1 

3 

CELLS  IN 

1 . 422E-01 

CM 

NZONES=  1 

36 

CELLS  IN 

1 .46  1EF0  1 

CM  DX  = 

1  • OOOE-O 1 

RATIO  = 

1 . 1 00E0 

EXTRA 

$  NL  1ST  RHL(9)  =  40*6.89E7.PHL(  9)=4O*6.85E7,ShL(9)-4O*6,09E7,P6(l  )=o.09E7, 
T6  (  1) =1  .0  S 
7/8/9 


FIGURE  C.14  INPUT  DECK  FOR  SPHERICAL  EXPLOSION  OF  PETN  IN  ROCK  MATCHING 

GROUT,  SHOWING  USE  OF  A  TABULAR  EQUATION  OF  STATE,  CAP  MODEL, 
AND  A  NAMELIST  STATEMENT 
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I  DENT  =  254  H  EXPLOSIVE,  FLYER,  AND  TARGET.  SIMULTANEOUS  DETONATION 
C  ELIMINATE  C,  D,  AND  S  FROM  EOS  FOR  EXPL.  LET  GAMMA  bE  CONSTANT. 


;  ADD  2 

CM 

TO  TARGET 

•  CHECK  WHETHER  RIGHT  IMPULSE 

IS  OdTAlNEO  (27.3  KbAR) 

NT  EOT  - 

o 

njedit  = 

2 

C 

C 

JEDI TS 

= 

11  12 

14  15 

2  C  24 

28  32 

36  40 

44  48  52 

56 

6C  64 

68  72 

NED  I  T  = 

1  0 

JCYCS  = 

1  7C 

CKS  = 

1C  .0 

TS  -  2.50CE- 

05 

NM  TRLS 

= 

3 

MATFL  = 

1 

UZERO  = 

0. 

EL-506D 

RHOS  = 

1  .4 

CFP  =  000 

DP  Y  =  002 

EQ  ST  = 

1 .0 

0. 

1  • 

2. 

2. 

0. 

TENS  = 

- 

1  • 

0  . 

1  .  OCOE'f  I  1 

MELT  = 

- 

1  • 

0. 

0  • 

0. 

C  • 

4L  60  61- 

T  6 

RHOS  = 

2. 7C7E0 

CFP  -  CCO 

DP  Y  =  OC  2 

NCON  = 

0 

EQST  = 

6. 670E+1 1 

1  •  00 OE  *■  1  2 

I  •  22 C E  -f  1  1 

2. 04 EC 

0 .25E0 

0. 

TENS  = 

- 

1 .0CCE+  I  1 

0. 

5. OOOE+CQ 

YIELD  = 

J. 21 0F+09 

2.670C+1 1 

3.79CE+1C 

OTWR 

RHOS  = 

1 • 63E  0 

CFP  -  000 

DPY  =  001 

NCON  - 

C 

EQST  = 

7.49CE+1 0 

I  . 50  OE ♦ I  I 

I  • 600E+  1 0 

0. 74E0 

0.25EO 

1 • 31 0E+ 1 I 

YIELD  = 

2 .400E+08 

3 • 00CE+1 0 

0  • 

NL  AYER 

- 

4 

JMAT  = 

I  2 

0  3 

NZONES= 

I 

1  0 

CELLS  IN 

0.202 

CM 

N Z ONES= 

1 

2 

CELLS  IN 

0.0406 

CM 

nz  Ones  = 

I 

0 

CELLS  IN 

1 . 3700 

CM 

NZ  ONE  S  = 

2 

37 

CELLS  IN 

I  *C 

CM,  DX  = 

I  .000E-02 

RATIO  -  1.05 

25 

CELLS  IN 

3.0 

CM,  DX  - 

6. 1 00E-02 

RAT  I Q  s  1.05 

EXTRA 

$NL 1ST 

EHL 

(  I  )  =  1  0*3. 64E  +  1 0  % 

7/8/9 

FIGURE  C.1 5  INPUT  DECK  FOR  EXPLOSIVELY  THROWN  FLYER  PLATE  IMPACTING  OTWR 
AND  ILLUSTRATING  THE  USE  OF  EXPLOSIVE,  NAMELIST,  COMMENTS,  AND 
GAPS  IN  THE  LAYERS 
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IOENT  =  310  1  RUNNING  DETONATION 

C  TREAT  A  RUNNING  DETONATION  THROUGH  HMX,  COMP  0,  AND  TNT  TO  STUDY  THE 


C  EFFECT  DF  OVERDRIVING  OF  A 

LOW  C-J  EXPLOSIVE  BY  A  HIGH  C- 

-J  EXPLDS1VE. 

NTEDT  = 

0 

NJEDIT  = 

2 

JED1TS= 

1  16 

3  1  46 

6  1  77 

80  84 

93  102 

1  05 

109  118 

1  27 

130  134 

137  140 

NED  1 T  = 

1  0 

JCYCS  - 

200 

CKS  = 

30.0 

TS  = 

1  •  0  0  OE 

-04 

NMTRLS  * 

4 

MATFL  * 

1 

UZERO  = 

0. 

HMX 

RHOS  * 

1.84 

CFP  *  000 

DP  Y  =  012 

EQST  * 

1  *0 

0  • 

1  .0 

1.89 

1.89 

0. 

QEXPL* 

5.690E+1 0 

0.0625 

2.0 

TENS  * 

-1.0 

0.  -l.OOOE+ll 

MELT  * 

-1  .0 

0  • 

0. 

0  • 

0. 

COMP  B 

RHOS  = 

1 .68E0 

CFP  =  000 

DPY  =  012 

NCDN  = 

0 

EQST  = 

1  #E0 

0  • 

1  .EO 

1.63E0 

1.63E0 

0. 

QEXPL  = 

5. 190E* 1 0 

0.0625E0 

2.E0 

TENS  = 

-1  .EO 

0. 

■l.OOOE+ll 

MELT  = 

-1  .EO 

0  • 

0  • 

0  • 

TNT 

RHDS  = 

1.56E0 

CFP  =  000 

DPY  =  012 

NCDN  = 

0 

EQST  = 

1  .EO 

0  • 

1  .EO 

1 .44E0 

1 .44E0 

0. 

QEXPL  * 

4.520E+10 

0 .0625E0 

2.0 

TENS 

-1  .EO 

0  • 

•  l • OOOE*  1  1 

MELT  = 

-1  .EO 

0  • 

0. 

0. 

0. 

AL6061-T6 

RHOS  = 

2. 707E0 

CFP  =  000 

DPY  -  001 

NCDN  = 

0 

EQST  = 

6. 670EM  1 

1  .0  0  OE ♦  1  2 

1 . 220  E  4- 1  1 

2 • 04  E  0 

0.25E0 

0. 

YIELD  = 

3 • 2 1 OE  +  O  9 

2 . 670E+1  1 

3.790EM0 

NLAYER  = 

4 

JMAT  = 

1  2 

3  4 

NZ ONE  S=  1  80 

CELLS  IN 

10.0 

CM 

NZDNES=  1 

1  24 

CELLS  IN 

3.0 

CM 

NZ  DNE  S  =  1  24 

CELLS  IN 

3.0 

CM 

NZ  ONES=  I 

L  50 

CELLS  IN 

6.0 

CM 

7/8/9 

FIGURE  C.16  INPUT  DECK  FOR  A  RUNNING  DETONATION  THROUGH  THREE  EXPLOSIVES, 
ILLUSTRATING  THAT  PUFF  PERMITS  OVERDRIVING  OF  EXPLOSION 
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IDENT  =  DC5-A-1  SINTERED  AL203  *ITH  BE  AT  FRONT 
C  AUTOMATIC  RLZONINU  EVERY  30  CYCLES 

C  X-RAY  DEPOSITION  HAS  BEEN  CALCULATED  BY  -F  SCAT  T-  AND  PROVIDED  AS  A 
C  DEPTH-DOSE  PROFILE  FDR  THE  PUFF  CALCULATION. 


NT  ED  I  T  = 

1 

N  J  ED  IT  = 

1 

NR  E  Z  ONE  = 

-30 

TED  I  T  = 

5. 000E-09 

JEDITS  = 

5  1  7 

26  40 

40  61 

66  68 

70  72 

74  76 

70  80 

dtmax  = 

5 . 00CE-09 

TREZQN  = 

5.0C0E-09 

NEOIT  = 

30 

JCYCS  * 

200 

CKS  = 

2.0 

TS  = 

1  . 50  0  E- 0  6 

NMTRLS  = 

3 

MATFL  = 

0 

UZERO  = 

0. 

BERYLL 1 UM 

RHUS  = 

1 . 85E0 

CFP  -  000 

DP  Y  -  00  1 

EQ  ST  = 

1 • 203E4 1 2 

1 • 524E4 1 2 

3. 550E4  I  1 

1 . 45E  0 

2.500E-0 1 

5. 1 30E  4 1  l 

0  • 

MELT  - 

3. 95 5E 4 1 0 

1 .978E41 0 

1  . 5  00  E -0 1 

2.500  E -0  1  - 

-6. 000E-02 

4. 500E-01 

ALUMINA  S 

1 NTERED 

RHOS  = 

3  •  969 

CFP  =  001 

DP Y  -  004 

EQ  ST  = 

2 . 65  5E 4 1 2 

4  .200E  +  1 2 

3 .080E4 1 1 

1 .320E400 

2 • 500E-0 1 

2.090E41 2 

RHO  = 

3. 1 6E0 

AK  = 

1  •  70  0 E 4  1  2 

MU  P  = 

1 . 000E4 1 2 

YO  = 

3.000E409 

NR  EG  = 

3 

RHOP  = 

2  •  BE 0 

3  .  E  0 

3. 92E0 

4. 44E0 

4. 4 4 E  0 

4  •  5E0 

Cl  = 

.050 

.050 

.050 

.050 

.050 

.050 

PI  = 

3. OOOE+1 0 

1  P2  = 

5.000E41 0 

DELP  = 

0. 

2P2  = 

1.400E4U 

DELP  * 

•2.500E410 

YADDP  - 

1  • 0  00  E  4 1 0 

3P2  = 

3. 350E4 1 1 

DELP  =  -2 .200E4 10 

YADDP  -= 

1 . 000E41 0 

MELT  * 

4. 500E41 0 

1 .350E41 0 

2.0  00  E- 02 

.9 

•  2 

YIELD  = 

6 • 600E4 1 0 

1  . 600E  +  1 2 

TENS  * 

-1 .000E 409-1 . 0 00 E 409-1  .OOOE  +  ll 

VI  SC  * 

2.0 

•  02 

C-7 

RHDS  * 

1.190 

CFP*  000 

DP Y  =  001 

EQ  S  T  * 

7. 816E4 10 

1  « 956E  4  11 

8.000E409 

•  79 

•  20 

2*21 3E  411 

EMELT  * 

6.000E+09 

4.000E409 

•  1 

.  6 

-.15 

NL AYERS* 

4 

JM  AT  * 

1  2 

3  3 

NZ  ONES*  1 

31 

CELLS  IN 

.1 

CM  DX  * 

.0076 

RATIO  * 

•  935 

NZONES*  1 

31 

CELLS  IN 

•  1 

CM  DX  * 

•  001 

RATIO  * 

1  *07 

NZONES*  1 

17 

CELLS  IN 

•  IS 

CM  DX  * 

•  01 

RAT  ID  * 

1.07 

N ZONES*  1 

30 

CELLS  IN 

•  so 

CM 

NS  PEC  * 

1 

ANGLE  * 

0. 

SPEC  DC 

NARB 

ECAL  * 

200. 

START  = 

0  • 

S  ST  OP  = 

3.000E-09 

IDENT  *  DCS  AL2D3 

TH  *  NP= 

7 

(  8E 10. 3) 

0. 

1  .073E  +  0 1 

8. 333E-03 

9. 1 78E-01 

1  • 667E-02 

6 .342E-0 1 

2 . 500E  —  0  2 

4  #  95  4  E—  0 1 

5 . OOOE-O  2 

3. 090E-0 1 

7. 500E-02 

2.31 7E-01 

1  .OOOE-O  1 

1 . 866E-01 

IDENT  *  DCS  AL203 

TH  =  NP= 

13 

(BE10.3) 

1 . OOOE-O 1 

6 . 638E  +  00 

1 .008E-0 1 

5.  31 9E40C 

1 . 01 7E-0 1 

4 • 480E400 

1 .025E-01 

3.895E400 

1 . 050E-0  1 

2.871 E+00 

1 .075E-0 1 

2. 334E400 

i • 1 OOE-O 1 

2. 002E400 

1 • 1 75E-0 1 

1 . 473E400 

1 • 250  E- 0 1 

1 . 208E4C0 

1 • 325E-01 

1 .04 1E400 

1 .550E-01 

7  .652E-0 1 

1 . 775E-0 1 

6.230  E—  0 1 

2. OOOE-O 1 

5.41  IE-01 

IDENT  =  DC  5  AL203 

TH  =  NP= 

7 

(SE10.3) 

2.000E-01 

7. 378E-02 

2. 250E-01 

7. 309E-02 

2 . 500E-0 1 

7.238E-02 

2 • 750E-0 1 

7 • 1 65E-02 

3. 000E- 01 

7.09  1 E  — 0  2 

3.250E-01 

7.01 6E-02 

3.500E-01 

6. 940E-02 

IDENT  =  DCS  AL2D3 

TH  *  NP= 

7 

(BE  10. 31 

3. 500E-01 

6 .940E-02 

4 • 333E-0 1 

6 . 68  IE- 02 

5. 1 67E-0 1 

6.4  1  4E-02 

6  •  OOOE-O 1 

6.141 E-02 

6. 833E-0  1 

5.86  IE-02 

7. 667E-01 

5.572E-02 

8. 500E-0 1 

5.270E-0  2 
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FIGURE  C.1 7  INPUT  DECK  FOR  RADIATION  INTO  BERYLLIUM  AND  ALUMINA,  SHOWING 
THE  USE  OF  A  DEPTH-DOSE  PROFILE,  GEOMETRIC  LAYOUT,  AND 
AUTOMATIC  REZONING 
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IDENT  1002  X-RAY  DEPOSITION  INTO  AL  FOR  POST  TEST  STUOY 
C  THE  X-RAY  DEPOSITION  HAS  BEEN  CALCULATED  BY  — F SCATT-  AND 
C  A  DEPTH-DOSE  PROFILE  FOR  THE  PUFF  calculation 


IS  PROVIDED  AS 


N  TED  I  T  = 

0 

N JEO  I  T 

2 

NREZON  - 

0 

JEDITS  = 

28  31 

34  37 

40  43 

I  5 

10  IS 

20  2  S  45  50 

SS  60 

6S  70 

NEOIT  = 

30 

JCYCS  = 

1  50 

CKS  = 

2. 000E+0I 

TS  =  S.000E-07 

NMTRLS  = 

I 

MATFL  - 

0 

UZERO  = 

0. 

AL  1145 

RHOS  - 

2. 7E0 

CFP  =  010 

DP Y  =  003 

E  QST  = 

7.600E+ 1 1 

I  .500E  +  1 2 

1  •  2  2  0  E  4-  1  I 

2.C4E0 

2.S00E+01 

0.  c. 

DFRI  1145- 

•  1  •  COOE-02- 

-4. 000E+09 

I .0C0E-04 

3 .O0OE+O9 

-3 .000E  +  0  9* 

-4.C00E+08  0. 

VISC  = 

4  .C00E0 

S  .00CE-02 

0. 

0. 

0. 

0.  0 . 

YIELD  = 

2 . 000E+C9 

3.000E+1 1 

0  . 

0  • 

0  • 

0  •  0  • 

MELT  = 

6.59CE+09 

2 . 400E+C9 

I • S00E-01 

2 .SCOE-O I 

-6.000E-02 

0  • 

NLAYERS  = 

I 

JMAT 

1 

N20NES=  3 

27 

CELLS  IN 

I • I  COE -  0 I 

CM  OX  = 

3.S00E-03 

RATIO  =  9.S00E-0I 

17 

CELLS  IN 

3. 400E-02 

27 

CELLS  IN 

I  • I 00  E- 01 

CM  CX  = 

1  .000E-03 

RATIO  =  1.05E0 

NS  PEC  = 

1 

ANGLE  = 

0. 

DQFOST 

NAR6  0 

ECAL  = 

7 . 44  OE ♦ 02 

START  - 

0. 

SSTOP  =  5 • 00  OE- 09 

IDENT=DQPOST  NOS. 

TH  =  NP  = 

S 

( QE 10.3) 

2.41 3E0 

6 • 106E-C2 

2.4  76E0 

S.707E-02 

2 • 54E  0 

S.  33 SE - 0 2 

2.603EC  4 . 98  IE- 02 

2. 667E0 

4. 978E-02 

7/8/9 

FIGURE  C.18  INPUT 

DECK  FOR 

RADIATION 

INTO  ALUMINUM,  SHOWING  A  DEPTH-DOSE 

PROFILE  AND  MULTIPLE  ZONES  IN  ONE  LAYER 
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I  DEN  T  =  610  20  C  CAL  RADIATION  WITH  SPECTRA  IN  3  TIME  INCREMENTS 
C  THE  RADIATION  HAS  BEEN  SEPARATEO  INTO  A  SERIES  OF  BLACK  BODY  RADIATORS 


z  each 

WITH  ITS 

OWN  TEMPERATURE  ANO  TIME  OF  DEPOSITION. 

NTEDIT  = 

9 

NJEDIT  - 

I 

NREZON  = 

4 

NALPHA  = 

I 

TEOIT  = 

1 . 000E- 

•08 

I  •  0  00  E  —0  7 

2.0C0E-07 

4 . C 00 E—0  7 

7.00  OE  — 0 7 

I  .  000E-06 

I  . 4  0  OE- 06 

2.000E- 

06 

3. 000E-06 

JEDIT  - 

25 

42 

54  100 

128  142 

NTR  = 

2 

3 

4  5 

JREZQN  = 

45 

60 

80  110 

NEOIT  = 

50 

JCYCS  = 

2  00 

CKS  - 

6  .EO 

TS  = 

6.00  OE—  06 

NMTRLS  = 

I 

MATFL  = 

0 

UZERO  = 

0. 

ALUM  I NUM 

RHOS  = 

2.765E0 

CFP  =  000 

DP  Y  =  004 

NCUN  =  I 

EG  ST  = 

7.55CE+I 1 

I • 290EF 1 2 

I .220EF1I 

2 . 04  EO 

2.5C0E-01 

1 • I 97EFI2 

3 • I I OEF 10 

TENS  = 

—2 •  00  0  E  +  I 0 

0  • 

-2.000E*  10 

CO  SQ  = 

3 • 2  4E  0 

2.500  E- 0 I 

0  • 

YO  = 

2 .500E+09 

2.870E+11 

EMELT  = 

I •060E+10 

2  .400E+09 

I  . 500  E  —  0 1 

2 .5  00E  — 0  I 

-6. 000E-02 

ALUMINUM 

I  TAPE  = 

5 

PH  W  = 

1  • 

aluminum 

X-RAY  AtiS  NOE  = 

2 

AT  WT  = 

26.98 

EDGE  I  = 

I.00000C  0*  1 • 56  00  OE  0 

COEF1 

1  .08710E  1 •  —  2*7841 5E  0.  I 

•89848E  - 

1  .  .0  000  OE 

0 

COEF2 

1*31 739E  1.-2.18214E  0.-2 

!  . 58940E  - 

It  2  .22  834  E 

-2 

NLAYERS 

1 

JMAT  = 

1 

NZONES= 

3 

40 

CELLS  IN 

1 .224E-02 

CM  DX  = 

1 .000E-04 

RATIO  = 

I . 051E0 

33 

CELLS  IN 

5.776E-02 

CM  OX  = 

7.1 87  E  — 04 

RATIO  = 

I  •  05  EO 

76 

CELLS  IN 

2.93E0 

CM  DX  = 

3.618E-03 

RATIO  = 

1 .05E0 

NS PEC  = 

3 

ANGLE  = 

0. 

NHNU 

NBB  - 

1 

ECAL  = 

4.2E0 

START  » 

0. 

SSTOP  - 

3. 500E-09 

200  CAL 

TEMP  = 

3.7E0 

ECAL  = 

4.2E0 

NHNU 

NBB  = 

I 

ECAL  = 

8.7E0 

start  = 

3.500E-09 

SSTOP  = 

4.500  E—  09 

200  CAL 

TEMP  = 

2.  370 

ECAL  = 

8.7E0 

NHNU 

NBB  = 

I 

ECAL  = 

1 . 380E  +  01 

START  - 

4 . 500  E  —  0  9 

SSTOP  = 

5.500  E—  09 

200  CAL 

TEMP  * 

2.08E0 

ECAL  = 

1.380EF01 
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FIGURE  C.19  INPUT  DECK  FOR  RADIATION  FROM  THREE  BLACK  BODIES  INTO 

ALUMINUM,  SHOWING  FOUR  REZONES  AND  MULTIPLE  ZONES  IN  ON 
ONE  LAYER 
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IDENT  *  NEUTRON  GEN/CONE IGURATK ON  W/ZRCLY-2  CLADDING 


NT EOT  * 

1 

NJEDIT  * 

1 

NREZDN  » 

0 

TED IT  * 

l .000E-09 

JEDIT  » 

SI •  1.03 

•  1.06.1*09. 1 • 

2.1. 4. 1.6. 

1 .8. 2. 5. 3. 5. 4. 5 

NEDIT  * 

5 

JCVCS  * 

200 

CKS  » 

10. EO 

TS  * 

NMTRLS  * 

4 

MATFL  * 

0 

UZERO  * 

0. 

U— 3PCTMO 

RHDS  * 

17.8608E0 

CFP  =  000 

DP Y  *  004 

EQ  ST  » 

I . 20  2E+  1  2 

1.459E+12 

2.059E+ 10 

2.03E0 

2.500E-01 

5.840E412 

MELT  = 

2.050E+09 

1 .2  71 E  40  9 

1.160E-01 

5.000E-02 

0. 

YIELD  = 

9.  I 00E+08 

6.31 4E+ 1 1 

TENS  * 

—  8.000E  +  0  9— 1 . 0  0  OE  +  1 1 

0. 

vise  * 

4.E0 

5.000E-02 

5.000E-02 

NA-600C 

RHOS  = 

8.080E  —  01 

CFP  =  000 

DPY  =001 

EQST  = 

3.200E+10 

0.0 

1 • 000E  + 1 1 

l.OEO 

2.500E-01 

TENS  * 

— I • OOOE+1 l-l .OOOE+1 1 

0. 

ZIRCALOY-2 
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FIGURE  C.20  INPUT  DECK  FOR  RADIATION  BY  A  DEPTH-DOSE  PROFILE  INTO 
LAYERS  AND  ILLUSTRATING  USE  OF  HDATA  AND  TEDITs 
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FIGURE  C.21  INPUT  DECK  FOR  PRESSURE  LOADING  ON  A  THREE-LAYERED  PLATE, 
SHOWING  USE  OF  THE  NAMELIST  STATEMENT 
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FIGURE  C.22  INPUT  DECK  FOR  SIMULATING  AN  AIR  SHOCK  BY  APPLYING  A  PRESSURE 
BOUNDARY  THROUGH  NAMELIST 
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The  material  properties  give  samples  for  ductile  fracture  (DFRACT 
in  Figures  C.3,  C.7,  and  C.18),  brittle  fracture  (BFRACT  in  Figure  C.8), 
and  shear  banding  (SHEAR2  in  Figures  C.ll  and  C.12).  Porous  materials 
are  modelled  by  POREQST  in  Figures  C.6,  C.9,  C.13,  and  C.17  and  by  CAP1 
in  Figures  C . 10  and  C.14.  The  composite  model  REBAR  is  used  in  Figure 
C . 10 .  The  tabular  equation  of  state  EOSTAB  is  used  for  PETN  in  the 
data  deck  in  Figure  C.14.  Explosives  are  treated  in  various  ways  in 
Figures  C.ll,  C.12,  C.14,  C.15,  and  C.16. 

In  the  layout,  most  materials  are  treated  with  uniform  size  cells. 
However,  multiple  zones  within  a  layer  are  used  in  Figures  C.15,  C.18, 
and  C.19.  The  geometric  cell  layout  is  featured  in  Figures  C.5,  C.8, 

C.14,  C.15,  and  C.17  through  C . 20 .  Gaps  between  layers  occur  in  Figures 
C.13  and  C.15.  A  large  number  of  layers  (up  to  30)  are  permitted  as 
shown  in  Figure  C.10.  For  planar  geometry,  an  infinite  boundary  may 
occur  at  the  first  or  last  coordinate  by  making  the  first  or  last  JMAT 
value  negative  as  shown  in  Figure  C.22.  For  convenience,  the  thickness 
dimension  may  be  inserted  in  English  units  if  columns  41  to  45  contain 
the  letters  n_INCHn  (See  Figures  C.ll  and  C.22).  GENRAT  changes  the 
dimensions  to  centimeters  for  internal  use  and  for  printing  later. 
Depth-dose  profiles  are  shown  in  Figures  C.17,  C.18,  and  C.20;  black 
body  x-ray  spectra  appear  in  Figure  C.19  and  an  arbitrary  spectrum  in 
Figure  C.5. 

The  EXTRA  and  HDATA  lines  following  the  normal  data  deck  permit 
many  special  features.  In  Figure  C.3,  the  EXTRA  line  provides  the 
internal  energy  for  the  hot  aluminum  and  resets  the  density  to  its  normal 
value  for  the  equat ion-of-s tate  calculations.  A  similar  effect  is 
illustrated  in  Figure  C . 20 .  In  Figures  C.14,  C.21,  and  C.22  a  pressure 
boundary  is  provided  by  specifying  P6  and  T6.  A  preload  is  given  in 
Figure  C.14.  A  simultaneous  detonation  of  EL-506D  is  provided  in 
Figure  C.15  by  the  insertion  of  internal  energy  through  the  EXTRA  line. 

In  Figure  C.22,  the  air  is  initialized  at  a  moderate  pressure  by  providing 
it  with  some  internal  energy  (treating  it  as  an  explosive  undergoing  a 
simultaneous  detonation),  and  the  steel  is  preloaded  by  decreasing  the 
density  in  the  EXTRA  line.  Figure  C . 20  contains  a  data  deck  with  both 
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EXTRA  and  HDATA  lines.  The  HDATA  line  sets  the  boundary  indicators  to 
the  MIRROR  case  to  simulate  a  fixed  or  reflecting  boundary  on  both  sides. 
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Appendix  D 


FMELT :  THERMAL  REDUCTION  FUNCTION 


The  subroutine  FMELT  is  used  to  reduce  the  strength  and  shear  moduli 
as  a  function  of  the  internal  energy.  FMELT  contains  two  functions.  The 
first  (F)  normally  affects  the  yield  strength,  spall  strength,  and  the 
amplitude  of  the  compaction  surface  in  porous  materials.  The  second 
function  (FG)  reduces  the  shear  modulus. 

FMELT  is  called  in  GENRAT  for  initialization,  and  in  HSTRESS  to 
compute  the  nondimensional  reduction  factors. 

Formulation  of  the  Model 

The  strength  reduction  and  modulus  reduction  factors  are  presumed 
to  have  the  form  shown  in  Figure  D.l  for  several  grades  of  aluminum.  The 
reduction  factor  is  described  by  a  series  of  parabolas  as  illustrated  in 
Figure  D.2.  Up  to  three  parabolas  are  used.  Each  parabola  is  defined  by 
the  coordinates  of  its  end  points  plus  the  amplitude  at  its  midpoint. 
These  input  quantities  are  transformed  to  coefficients  of  the  series 
for  F.  In  the  ith  interval,  the  coefficients  are 
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SOURCE:  Metals  Handbook,  Vol.  I, (American  Society  of  Metals,  1961),  pp.  936,  940.  GA-^6586-30 

FIGURE  D.1  VARIATION  OF  STRENGTH  WITH  TEMPERATURE  FOR  ALUMINUM  1100 


148 


1.0 


F 


0  -  - 

0  MELT  =  E1 

ENERGY,  E 


ENERGY,  E 


NO  PARABOLIC  REGIONS 


ONE  PARABOLIC  REGION 


TWO  PARABOLIC  REGIONS 


ENERGY,  E 


THREE  PARABOLIC  REGIONS 


ENERGY,  E 


STANDARD  PARABOLA  AND  DEFINITION  OF  TERMS  IN  DERIVATION 

MA-6802 -6 
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E  ,  ,  E  ,  F  ,  F  =  energies  and  amplitudes  on  the  right 
Kl  Ll  Kl  Ll 

and  left  sides  of  the  interval 

AF  =  the  offset  of  the  midpoint  of  the  parabola  from  a 
straight  line,  as  shown  in  Figure  D.2. 

Sample  inputs  for  the  strength  and  modulus  reduction  factors  are  listed 
in  Appendix  C. 

Several  options  are  available  to  the  user  with  the  FMELT  function. 
From  zero  to  three  parabolas  may  be  used  to  define  the  function.  The 
number  is  determined  automatically  by  the  number  of  input  values  used. 
Both  strength  and  modulus  reduction  functions  may  be  used  or  only  the 
strength  reduction  function.  If  only  the  strength  reduction  function 
is  supplied,  the  same  function  is  used  for  modulus  reduction. 

The  data  are  supplied  as  a  series  of  numbers  designated  E^, 

E^.-.Eg  in  Figure  D.2.  The  first  parameter  E^  is  always  the  melt 
energy  in  erg/g.  The  other  parameters  vary  in  significance  according 
to  the  number  of  parabolas  as  shown  in  Figure  D.2.  The  sign  convention 
for  AF  and  the  slopes  at  the  end  of  the  parabolic  segment  are  shown  in 
the  last  diagram  of  D.2.  The  slopes  of  the  parabola  at  its  ends  are 
determined  graphically  by  passing  straight  lines  through  the  end  points 
and  a  point  2AF  from  the  midpoint  of  the  straight  line  segment  as  shown. 
It  is  advisable  to  examine  the  slopes  to  verify  that  the  chosen  parabola 
matches  the  experimental  data  adequately  and  does  not  contain  a  local 
minimum  or  maximum. 
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Appendix  E 


RESIZING  THE  CELLS:  REZONE 

The  purpose  of  rezoning  is  to  give  the  cells  an  optimum  size 
distribution  for  the  hydrodynamic  calculations.  During  the  radiation 
deposition  or  shortly  after  impact  (first  part  of  the  calculation) ,  the 
cells  near  the  radiated  face  or  near  the  impact  interfaces  should  be 
small  to  correctly  depict  the  wave  motion  at  those  points.  Later  on, 
as  the  waves  spread  out,  the  presence  of  the  small  cells  merely  slows 
down  the  hydrodynamic  computations.  Therefore,  REZONE  is  called  to 
gradually  increase  cell  size  (the  current  REZONE  does  not  decrease  size) . 
As  outlined  in  Section  5.1,  rezoning  begins  either  at  the  right  boundary 
(negative  NREZON)  or  at  JREZON  (positive  NREZON)  and  sweeps  to  the  left, 
resizing  groups  of  cells  to  obtain  the  desired  size.  If  cells  are  already 
larger,  they  are  unaffected.  Because  there  are  fewer  cells  following 
each  rezoning,  the  initial  coordinate,  UNIT,  is  increased  by  each  call 
to  REZONE. 

The  following  guidelines  were  used  in  calculating  the  redistribution 
of  coordinates: 

•  Boundaries  must  remain  as  coordinate  points 

•  JEDIT  locations  (Lagrangian  coordinates  at  which 
printouts  are  requested)  should  not  be  disturbed. 

•  Cell  thicknesses  should  not  be  allowed  to 
vary  rapidly  in  a  material. 

•  Across  boundaries,  the  cell  thicknesses  should 
vary  so  that  the  crossing  time  of  a  wavelet  is  the 
same  across  any  cell;  that  is. 


AXX  AX2 


(E.l) 


where 


AX  ,  AX2 
Cl*  C2 


cell  thicknesses 
sound  speeds. 


151 


•  Smoothing  of  the  wave  should  be  minimized.  For 
cell-centered  quantities  (SHL,  PHL,  EHL,  etc.) 
this  is  accomplished  by  weighting  the  old  cell 
quantities  according  to  their  contribution  of 
mass  to  the  new  cell.  For  example,  the  new 
internal  energy  is  computed  from 


enew 


2  EOLDpAX 

EpAX 


(E.2) 


•  As  illustrated  in  Figure  E.l,  the  summations  are  carried  out 
from  XSTART  to  XFIN,  the  boundaries  of  JNEW.  For  coordinate- 
centered  quantities,  such  as  U,  a  more  complicated  technique 
is  required,  as  explained  later. 

•  Neglect  conservation  of  kinetic  energy.  Because  cells 
are  usually  larger  when  rezoned,  this  neglect  will  lead 
to  some  loss  of  total  energy. 


DISTANCE,  X 


G  A-6586-36  A 


FIGURE  E.l  LAYOUT  FOR  COMPUTING  PROPERTIES  AT  REZONED  COORDINATES 


The  subroutine  that  was  constructed  to  perform  th6  rezoning  is 
naturally  separable  into  three  parts:  one  to  locate  the  initiation 
point  of  rezoning,  one  to  select  rezonable  sets  of  cells,  and  one  to 
compute  the  new  cell  properties.  In  the  first  part  of  the  subroutine, 
the  control  variable  (JTS  for  NREZON  <  0  and  JREZON  for  NREZON  >  0)  is 
located  with  respect  to  material  boundaries.  A  possible  layout  of  the 
coordinates  is  shown  in  Figure  E.2.  (JEDITS  need  not  be  in  numerical  order.) 
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Coordinates  are  not  all  rezoned  at  once,  but  in  groups  between  JEDIT, 
material  boundaries,  and  spall  planes.  The  second  part  of  the  sub¬ 
routine  searches  for  these  rezonable  groups  of  coordinates.  Figure  E.3 
defines  some  nomenclature  used  in  the  searching  process. 
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In  the  third  part  of  the  program,  the  rezonable  set  of  cells  is 
tested  before  rezoning.  If  the  number  of  cells  ahead  is  less  than  the 
number  that  would  be  obtained  in  the  rezoning,  a  check  is  made  to  determine 
whether  a  region  of  small  cells  is  followed  by  a  region  of  large  cells  in 
the  rezonable  set.  (This  is  likely  in  a  radiation  problem  because  the 
surface  material  expands.)  If  there  is  a  region  of  small  cells,  the 
rezonable  set  is  truncated  to  include  only  those  small  cells,  and 
rezoning  is  performed.  If  the  numbers  of  new  cells  and  old  cells  are 
equal  and  the  old  cells  have  a  fairly  uniform  thickness,  then  the 
coordinates  are  simply  renumbered.  If  computation  of  new  properties  is 
called  for,  the  calculations  are  performed  as  described  in  the  guidelines 
above.  If  the  rezonable  set  of  cells  is  terminated  at  the  left  by  a 
boundary  or  spall  surface,  then  the  new  coordinate  at  JFIRST  is  included 
in  the  computation  of  the  current  set  of  cells.  For  other  termination 
conditions  of  the  rezonable  set,  new  properties  are  computed  up  to,  but 
not  including,  the  new  coordinate  at  JFIRST.  Those  properties  will  be 
computed  with  the  next  rezonable  set. 

Conservation  of  Momentum:  Velocity  Computation 

Several  approaches  are  available  for  conserving  total  momentum  in 
computing  the  new  particle  velocity  array.  Because  the  velocity  array 
is  associated  with  the  coordinate  points,  the  approach  used  was  to 
compute  a  momentum  associated  with  each  coordinate.  The  requirements 
for  the  computation  were  to: 

•  Preserve  momentum  exactly. 

•  Leave  the  velocity  unaltered  if  the  cell  dimensions 
on  both  sides  of  the  coordinate  are  unchanged. 

The  momentum  associated  with  a  coordinate  is  computed  by  weighting  the 

momenta  near  the  new  coordinate  in  proportion  to  the  distance  from  the 

coordinate . 

The  momentum  is  separated  into  two  components:  a  term  proportional 
to  the  average  momentum  (the  usual  momentum  term)  and  a  term  related  to 
the  variation  of  momentum  across  the  cell: 
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where 


Mal2  =  one-half  the  momentum  of  the  cell  between  coordinates  1  and  2 
=  the  contribution  to  coordinate  1  of  the  variation  of 


momentum  in  the  cell  1-2 


Xx  -  the  location  of  coordinate  1 
AX  =  the  dimension  of  cell  1-2. 

The  coefficient  (-3/AX)  and  weight  factor  (£  -  X^  -  ~)  in  were 

determined  by  requiring  that  =  0  if  pu  is  uniform  in  the  cell  and 

that  the  velocity  U,  be  unchanged  if  the  cell  size  is  unchanged.  The 
new  velocity  will  be  computed  from 


where  Z 
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M  +M 

u  =  2  -1 j-  01 

1  (Z12+  ZC1) 

is  the  mass  of  the  cell  between  coordinates  1  and  2. 
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To  keep  unchanged,  M12  must  be  a  function  of  Ih  only.  The  momentum 
at  coordinate  2  from  cell  1-2  is 


M  =  M 
21  al2 


“blS 


As  an  example,  consider  a  cell  bounded  by  coordinates  with  velocities 
and  U2 .  Then  the  velocity  at  any  point  is 

K  -  x. 


u  =  U1  +  (u2  -  V 


AX 


(E.7) 


and  Mal2  =  lMpAX^  +  U2) 

\12  =  l/2pAX(U1  -  U2) 


Hence, 


M12  =  l/2pAXU1 
M21  =  l/2pAXU2 
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The  more  general  problem  is  one  in  which  a  portion  (from  X|  to  X^) 
of  an  old  cell  contributes  to  a  new  cell.  The  velocities  at  the  boundaries 
of  this  portion  are  computed  from 


U’  =  U. 
1  J 


+ 


(Vi  -  "a' 


xi  - 


X  -  X. 
J+l  J 


(E.8) 


X2  "  XJ 

u2  =  uj  +  (Vi  -  V  3T— rx. 

j+i  j 


(E.9) 


where  the  U  and  X  quantities  with  j  subscripts  refer  to  the  old  cell 
velocities  and  locations.  Let 


xi  + 


X2 


-  X, 


AX 

2 


(E . 10) 


the  distance  between  centroids  of  the  contributing  portion  of  the  old 
cell  and  of  the  new  cell;  ~  ^  the  contributing  portion  of  the 

old  cell.  Then  the  momentum  contributions  of  the  portion  are 


Mal2  '  I  P  52(Di  +  "P  <E-U) 

“tia  ■  -  isr  i6Vui +  +  52cu2  -  ui»  (E-12> 


In  the  code  these  two  momentum  quantities  are  AMAVG  and  AMSLP.  The  sums 
and  differences  are  stored  in  the  MOM  array. 


Detailed  Treatment  of  Coordinate  Arrays 

The  coordinate  arrays  may  be  divided  into  four  groups  according  to 
their  reference  point  (cell  or  coordinate)  and  numerical  or  nonnumerical 
character.  The  cell  quantities  are  sound  speed,  density,  internal  energy, 
pressure,  stresses,  yield  strength,  mass,  H(J,1),  H(J,3),  and  other 
variables  associated  with  the  material  model.  The  H  quantities  are 
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integers  used  as  indicators;  consequently,  they  cannot  be  handled  by 
the  weighting  procedures  otherwise  appropriate.  Density  DHL  is  computed 
from  the  mass  ZHL,  rather  than  directly  by  averaging. 

The  coordinate  quantities  are  X,  T,  U,  and  H(J,2).  U  is  computed 
as  described  in  the  previous  subsection.  T,  the  spall  strength,  is  set 
to  the  initial  value  TENS(M,1)  except  at  interfaces  and  spall  planes. 
There  it  is  set  to  the  corresponding  T  value  in  the  unrezoned  array. 
H(J,2)  indicates  spall  or  interface  conditions  at  a  coordinate.  It  is 
reset  in  the  second  (searching)  portion  of  REZONE  following  computation 
of  new  cell  quantities. 

Printout 

Some  printout  is  obtained  from  each  major  step  in  REZONE.  Therefore 
if  problems  arise  because  of  rezoning,  they  can  usually  be  quickly  traced 
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Appendix  F 


ONE-DIMENSIONAL  CYLINDRICAL  AND  SPHERICAL  FLOW 


The  basic  wave-propagation  relations  for  one-dimensional  geometry 
are  derived  here  for  cylindrical  and  spherical  flow.  Included  are  the 
mass  and  momentum  conservation  equations,  expressions  for  the  internal 
energy,  elastic-plastic  stress-strain  relations,  and  spall  equations. 

Kinematic  Calculations 


The  equations  for  mass  and  momentum  conservation  and  the  expressions 
for  internal  energy  are  derived  here. 

For  spherical  flow,  consider  two  finite-difference  cells  bounded  by 
radii  r^,  r ^ ,  and  r^  and  subtending  an  arc  of  d0  in  orthogonal  circum¬ 
ferential  directions  as  shown  in  Figure  F.l.  The  mass  of  cell  1  is 

M 1=yL  d02  (r2  "  rl}  (F-1} 


2 

Mass  conservation  is  provided  by  storing  =  M^/d0 
for  cell  1.  Then  the  density  at  any  time  is 


as  a  constant 


P 


(F.2) 


Conservation  of  momentum  is  the  basis  for  determining  the  velocities 
of  cell  boundaries.  The  mass  associated  with  each  boundary  point  is 
half  the  mass  in  the  two  adjacent  cells.  The  forces  acting  on  this  mass 
are  computed  from  the  stresses  in  the  adjacent  cells  and  the  areas  they 
act  on.  The  stress  in  the  cell  between  r^  and  r^  acts  at  a  mid-mass 
radius  given  by 


-3 

ri 


(F.3) 
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MA-6802  -7 


FIGURE  F.1  CELL  GEOMETRY  CONSIDERED  FOR  ONE-DIMENSIONAL  SPHERICAL 
MOMENTUM  CALCULATIONS 
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and  thus  on  the  area  shown  in  Figure  F.l 


A 


1 


2-2 
dQ  r 


(F.4) 


The  radial  component  of  the  tangential  stress  is  ag^d0/2,  which  acts 
on  the  area  A^  on  each  side  of  the  cell  in  Figure  F.l: 


A12  '  1  2  2  <r2  '  L)d6 


(F.5) 


Assembling  all  the  radial  forces  on  the  mass  centered  at  r^  and 
extending  from  r  to  r^  gives 


a  .d0 

rl 


2-2 

rl-  ar2 


d0 


2-2 


+  4 


r^de 


+  a 


r2)d0 


(F.6) 


Here  AU  is  the  change  in  velocity  of  the  coordinate  r  .  Elimination 

2r  1 

of  d0  and  use  of  Eq .  (F.l)  for  the  definition  of  the  initial  cell 

mass  leads  to 


ail  = 


6  At[ari;J  -  ar2^2  +  a01(r1  +  r£)  (r2 


V  +  aQ2(r2  +  r2)  (r2  -  r^] 


Z1  +  Z2 


(F.7) 


In  Eq .  (F.7),  the  radial  stresses  are  augmented  by  the  artificial 
viscosity  stresses  for  the  momentum  calculations.  No  artificial  viscosity 
is  added  to  the  tangential  stresses. 

The  change  in  internal  energy  that  arises  from  the  work  done  is 


AE  =  V 


i 


PdV  +  V 


(F  .8) 
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Through  use  of  the  stress  and  strain  definitions  in  Section  4.1,  the 
energy  change  reduces  to 


AE  =  - 


(dv  +  Vde  ) 


(F.9) 


This  expanded  form  is  convenient  for  computations  because  the  first 
term  is  the  expression  for  planar  flow  and  the  second  is  added  only  for 
spherical  flow. 

For  cylindrical  flow,  the  finite-difference  cell  is  bounded  by  an 
inner  radius  r^  and  an  outer  radius  r  ,  subtends  an  arc  of  d0,  and  has 
indefinite  extent  in  the  Z  direction.  Motion  occurs  only  in  the  radial 
direction.  The  mass  of  the  cylindrical  cell  is 


M 


1 


(F .10) 


where  the  cell  is  assumed  to  have  unit  length  in  the  Z  direction.  Mass 
is  conserved  at  each  cell  by  storing  the  mass  Z  =  M/d0  for  each  cell 
and  computing  the  density  p  at  any  time  from  the  geometry  and  Z  as 
in  Eq.  (F.10) : 


P 


(F .  11) 


Momentum  conservation  follows  the  same  plan  as  for  spherical  flow. 


First,  a  mid-mass  radius  is  defined: 

2 


-2 

ri 


ri  + 


(F.12) 


The  area  of  action  of  the  radial  stress  at  mid-cell  is 


=  r  d9 


(F.13) 
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(F .14) 


and  the  area  for  the  circumferential  stress  a0^  is 


A12  -  d0(r2  -  r2) 


Assembling  all  the  radial  forces  on  the  boundary-centered  mass  at 
leads  to 


r 


2 


a  d0 

rl 


"  ar2  d0 


r2  +  a01d0(r2  - 


L  ~  Aar  n  -  Pd0  /  2  2n  AU^ 

°02  d0(r2  V2)  2  r3  rd  At 


(F . 15) 


Elimination  of  d0  and  use  of  the  definition  of  Z  leads  to 


AU2  =  4At 


°rl  ?1  '  °r2r2  +  °91(r2  ~  ?1>  +  °92(?2  '  r2> 

h  +  Z2 


(F.16) 


As  in  spherical  flow,  the  radial  stresses  in  Eq .  (F.16)  are  augmented 
by  the  artificial  viscosity  stresses;  the  tangential  stresses  are  not. 

The  change  in  internal  energy  in  cylindrical  flow  is  computed  from 
Eq.  (F.8)  with  the  aid  of  the  stress  and  strain  definitions  in  Section 
4.1.  The  energy  change  is 


AE  =  -  Jo±dV  +  J  (o'  -  o')  (dV  +  Vdep  (F .  17) 

The  first  term  is  the  expression  used  for  planar  flow.  The  second  term 
is  simply  added  for  cylindrical  flow.  This  term  is  similar  to  the 
second  term  in  Eq .  (F.9)  because  o'  =  -  o'/2  in  spherical  flow. 

The  foregoing  analyses  have  been  implemented  into  the  SRI  PUFF  code 
for  one-dimensional  wave  propagation. 
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Elastic-Plastic  Calculations  for  Planar,  Cylindrical,  and  Spherical 

Geometries 

In  this  section,  the  general  elastic  and  plastic  calculations  of 
Appendix  G  are  applied  to  one-dimensional  flows  with  linear  work-hardening. 

In  planar  flow,  strain  occurs  only  in  the  direction  of  propagation, 
and  the  transverse  strains  anc^  £3  are  zero.  Such  planar  flow  occurs 

during  impact  of  flat  plates  and  in  response  to  a  simultaneous  detonation 
of  an  explosive  over  a  plane.  In  cylindrical  flow,  only  radial  motion 
occurs.  Thus  radial  and  circumferential  strains  are  nonzero  but  axial 
strain  is  zero.  Cylindrical  flow  occurs  in  the  response  of  long  buried 
tunnels,  pipe  lines,  and  in  fragmenting  rounds  or  bombs.  In  spherical 
flow,  the  flow  is  all  radial  and  the  transverse  strains  are  equal  and 
nonzero . 

The  equations  for  one-dimensional  flow  are  summarized  in  Table  F.l. 

The  deviator  strain  is  defined  as 


de 


d£i  “  3^d£l  +  de2  +  de3^ 


(F.18) 


The  equivalent  shear  strain  quantities  are  derived  from  Eq .  G.5.  The 
expressions  for  the  equivalent  stress  a  are  from  Eq.  G.4. 

For  planar  flow,  stresses  are  found  by  first  computing  a,  from 


-  4  A 

°i  -  °i  -  °io  +  3^1 


(F. 19) 


which  can  be  obtained  from  Eq .  (G.ll)  because  Ae£  =  -^Ae^ , 

If  exceeds  2Y  / 3 ,  then  from  Eq.  (G.27) 

I  o 


* 

M<  +  2G  Y 
_ 1 _ o 

M  +  3G 


(F . 20) 


*  1*1 

where  Y  has  the  same  sign  as  a*  and  Y  --  Y  ,  the  yield  strength 
o  1  I  o  I  o 
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Table  F.l 


STRESS  AND 

STRAIN  QUANTITIES  IN  ONE-DIMENSIONAL 

Definitions 

FLOW 

Quantity 

Planar 

Cylindrical 

Spherical 

de 

ihi 

9u 

9u 

i 

9x 

9r 

9r 

d£2 

0 

u 

u 

r 

r 

de 

0 

0 

u 

3 

r 

de' 

Id, 

de,  -  |  — 

de  -i« 

1 

3  1 

1  3  p 

1  3  p 

de ' 

-  |  de 

-  d^  +4- 

1  ,  ,  1  dp 

-  -  de  H - — 

2 

3  1 

1  3  p 

2  1  6  p 

de' 

-  |  de 

1  dp 

-  *  de, 

3 

3  1 

~  3  p 

2  1  6  p 

de 

fKi 

U  r,  2  ,  dp  ,  ,1  dp.  2 

\/i[d£ i  ■  dei  r  +  (jr’ 1 

1  dei  1 

-P 

1  P  1 

/4,  . ,  Px  2  ,  Ps  2  P  P, 

i  P  i 

de 

kej 

Wjl [(dep  +  (de2)  +  de^de^ 

Kl 

a 

|i°;i 

+  °22  +  °i  °2> 

fla'I 

l  . 

I 

°2 

'  2  °1 

~ 

-L  > 

~  2  ai 

Notes:  Subscript  1  is  in  direction  of  propagation 

2  is  in  0  direction  in  cylindrical  flow 

or  any  transverse  direction  for  the  other 
two  flows 

3  is  in  third  orthogonal  direction 

.  F 

e.c  are  strain,  deviator  strain,  plastic  strain,  positive 
in  tension 

o>o',o  are  stress,  deviator  stress,  equivalent  or  Mises  stress 

P 

Y,y  are  equivalent  shear  strain,  equivalent  plastic  shear  strain 

u  is  displacement  in  the  direction  of  motion 

x,r  is  coordinate  in  the  direction  of  motion 

p  is  density. 
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at  the  previous  time  step.  The  plastic  strain  is  found  from  Eq.  (G.22), 
accounting  in  addition  for  the  possibility  that  the  increment  includes  the 
beginning  of  yielding. 


2GAei 


10 


M  +  3G 


(F.21) 


and  Y  =  Y  +  MAeP  =  Y  +  |m|AeP| . 

o  o  2  1 1 

This  result  agrees  with  the  fact  that,  for  perfect  plasticity  (M  =  0) , 
the  plastic  strain  is 


AeP  =  Ae^  =  |  Ae1  (F.22) 

and  there  is  no  change  in  the  elastic  deviator  strain. 

For  cylindrical  flow,  two  deviator  stresses  a  and 

-N  ^ 

from  Eq.  (G.26)  and  then  a  is  evaluated  from  Eq .  (G.4)  # 

-N 

then  a  is  reduced  from  a  as  follows: 

-N 

M O  +  3GY 

-  _  _ o 

°  M  +  3G 

The  individual  deviator  stresses  are  then  calculated  from  Eq.  (G.25): 

■  ai  h  (F-24) 

a 

0 

where  Y  =  Y  +  MAeP. 
o 

The  plastic  shear  strain  is  obtained  as  in  Eq.  (F.21): 


0^N  are  calculated 
If  aN  exceeds  Y, 


(F . 23) 
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(F. 26) 


AeP 


3GAe  -  Y  +  a 
_ o 

3G  +  M 


and  from  Eqs .  (G.24)  and  (G.25): 


AEI  ■  -  ie;E  -  Ae'i(1  -  h) 


(F.27) 


For  spherical  flow,  O is  first  computed  elastically  as  usual  and 
compared  with  2Y^/3.  If  yield  has  occurred. 


°i  = 


,N  * 

Mo,  +  2 GY 
_ 1 _ o_ 

M  +  3G 


(F . 28) 


and  the  plastic  strain  is 


„  3GAe,"  -  Y*  +  a 

AeF  =  - - - - -  (F .  29) 

1  M  +  3G 

^  P 

Note  that  in  spherical  flow,  the  relations  for  O  and  Ae:^  are  almost 
identical  to  those  in  planar  flow. 

The  plastic  strain  energy  is  associated  with  work  hardening,  tem¬ 
perature  rise,  and  thermal  softening,  and  is  used  in  some  dislocation 
models.  The  plastic  energy  is  defined  as 

AEP  =  V  Z  o'  deP  (F . 30) 

i  1  1 

p 

where  V  is  specific  volume  and  Ae  is  the  increase  in  specific  internal 
energy.  For  planar  and  spherical  geometries,  the  energy  change  is 

AEP  =  |  V  o'  dep  (F.  31) 

A  convenient  form  for  the  energy  change  in  the  cylindrical  case  is 

AEP  =  V  [o'  (2deP  +  deP)  +  o'  (2deP  +  deP) ]  (F.  32) 
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Appendix  G 


DEVIATOR  STRESS  MODELS 


This  appendix  gives  a  derivation  for  a  three-dimensional  deviator 
stress  model  including  elastic,  plastic,  and  work-hardening  behavior. 

The  plasticity  model  is  then  expanded  to  encompass  strain  rate  effects. 

Plasticity  Relations  for  Mises-Type  Models 

A  three-dimensional  computational  model  was  developed  for  yielding 
based  on  Reuss  (incremental  or  flow)  plasticity,  Von  Mises  yield  behavior, 
and  work  hardening  (See  Hill^  for  general  background).  The  following 
four  assumptions  form  the  basis  of  the  model: 

1 .  The  strain  can  be  separated  into  an  elastic  and  a  plastic 
component  at  each  step.  As  in  elasticity,  the  stress  is  proportional 
to  the  elastic  strain  component 

de  =  deE  +  deP  (G  .  1) 


2.  According  to  Reuss,  the  shear  (or  deviator)  stress  in  any 
direction  is  proportional  to  the  increment  of  plastic  strain  in  that 

direction.  The  mathematical  formulation  of  the  condition  is 


de 


12 


de 


23 


12 


23 


de 


13 


de 


11 


13 


11 


.  =  dX 


(G.2) 


These  relations  provide  for  changes  in  the  directions  of  the  principal 
stresses.  Inherent  in  Eq.  (G.2)  is  the  assumption  that  there  is  no 
volume  change  in  plastic  strain,  i.e., 

P  P  P 

de^  +  de2  +  de^  =  0  (G.3) 

where  the  singly  subscripted  strains  are  principal. 


169 


3 .  The  behavior  is  homogeneous  and  isotropic  even  with  work¬ 
hardening  .  Because  there  is  no  directionality,  the  state  can  be  defined 

completely  by  scalars.  The  chosen  scalars  are  an  effective  stress  O 

-P 

and  an  effective  strain  £  ,  which  are  invariant  under  rotation  and  do 
not  distinguish  between  the  three  principal  directions.  For  convenience, 
the  effective  stress  is  chosen  so  that  a  =  Y  at  yield.  The  usual 
definition  for  the  effective  stress  has  the  following  forms: 


a 


where 


a 


1 


y ^2  J ^3 


/|[(Oi  -  o2)2  ♦  (o2  -  03)2  -  (o3  -  0l)2] 

(G .4a) 

|/|[(ap2  +  (ap2  +  (a-)2! 

(G.4b) 

y^[a''2  +  a'2  +  a'2  +  2(t2  +  t2  +  t2  )] 

(G.4c) 

|/  3[(ap2  +  (ap2  +  o'o'  ] 

(G.4d) 

J  3  , 

Vi°u 

=  principal  stresses 

ara2,a3 


>•  ^  a 

a  ,a  ,a 
X  y  z 

T 


=  deviator  stresses  in  the  principal  directions 
=  deviator  stresses  in  the  coordinate  directions 

=  shear  stress. 


A  similar  definition  is  given  to  the  effective  plastic  strain,  de 

.  .  .  .  .  -P  p 

The  amplitude  is  fixed  by  requiring  that  d£  =  d£1  for  any  case  where 

P  P  -P 

de  =  d£  .  Then  d£  has  the  forms 


deP 


^ f [d£l  ‘  de2)2  +  (dE2  "  d£3)2  + 

+  (de^)2  +  (de^)2] 


(G.5a) 


(G. 5b) 
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=  l/|  [(de  P)2  +  ( d£P ) 2  +  (d£P ) 2  +  2(d£P  )2  +  2(dep  )2  +  2(d£P  )21  . 

'  3  x  y  z  xy  yz  zx  J  (G.5c) 


=  [(de^jV  +  (de^)2  +  de^de^] 


(G.5d) 


where 


P  P  P 
de1>  de2,  de3 


P  P  P 

de.de,  de 

x  y  z 


,  P  J  P  ,  P 
de  ,  de  ,  de 
xy  yz  zx 


plastic  strains  in  the  principal  directions 


plastic  strains  in  the  coordinate  directions 


plastic  shear  strains  (tensor  components). 


4.  The  yield  condition  describes  yielding  as  a  function  $  of  the 
second  invariant  of  the  deviator  stress  tensor 


where 


= 


(G .  6) 


-2 


-T-  - 


a2V 


+  (a2  " 


a3) 


and  K  is  a  constant  (yield  strength  in  pure  shear).  Yielding  occurs 
when  Eq.  (G.6)  is  satisfied.  Alternatively,  the  yield  criterion  can  be 
expressed  in  terms  of  the  equivalent  stress  a  and  the  yield  strength  Y 
in  simple  tension. 


The  preceding  assumptions  form  the  basis  of  a  plasticity  model  with 
an  "associated  flow"  rule.  For  such  a  model,  both  the  stress-strain 
relations,  Eq .  (G.2),  and  the  yield  function,  Eq.  (G.6),  employ  the 
same  function  (J) .  That  is,  Eq .  (G.2)  can  be  put  into  the  form 


(G  .8  ) 
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In  a  model  with  an  associated  flow  rule,  the  plastic  strain  vector  in 
principal  strain  space  is  always  normal  to  the  yield  surface  in  stress 
space;  this  condition  introduces  simplifications  that  will  be  used  later. 

Next  we  introduce  the  elastic  stress-strain  relations: 

E  6-ii 

o' .  .  =  2G(e  .  .  -  -=-1  l  e.  .)  (G  .9  ) 

ij  ij  3  n 

For  convenience,  we  can  simplify  Eq .  (G .9 )  by  defining  a  deviator 
strain  similar  to  the  deviator  stresses: 

6.  . 

e' . .  =  e . .  -  "r— ^  E  e..  (G .10) 

ij  iJ  3  n 

Then  Eq.  (G.9)  takes  the  form 


o'. .  =  2GeT.E  (g .11 ) 

ij  ij 

The  plastic  flow  relations,  Eq.  (G.2),  are  now  rewritten  into  a 
convenient  form.  If  each  term  in  Eq .  (G.2)  is  put  in  the  form 

p 

de . .  =  0.  .dX,  squared,  and  all  the  equations  are  added,  the  result  is 


9,  -Pn2  -2,^,2 
r(de  )  =  a  (dX) 

4 


(G  .12  ) 


Replacing  this  value  for 


dX  in 


o'  . 
ij 


Eq. 


(G.2)  provides 


the  convenient  form 


(G  .13  ) 


To  complete  the  model,  we  will  assume  that  work  hardening,  if  it 
occurs,  is  a  function  only  of  the  equivalent  plastic  strain.  The  increase 
in  the  yield  strength  is 


dY  =  MdeP 


(G.14) 
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where  M  is  the  work-hardening  modulus.  Hence  the  work  hardening 
assumed  is  independent  of  the  direction  of  straining  so  that  material 
remains  isotropic  during  plastic  flow. 

The  problem  we  face  can  now  be  formulated  as:  Given  the  total 
strain  increments,  the  stress  components  at  the  previous  time,  and  the 
yield  strength,  solve  Eqs.  (G.l),  (G.3),  (G.ll),  and  (G.13)  simultaneously 
for  the  stresses  O ^  . .  To  aid  in  visualizing  this  problem,  we  introduce 
a  vector  notation  for  both  principal  deviator  stress  and  principal 
deviator  strain: 


a  =  o'  i  +  o'j  +  o'  k  (G . 15) 


t  —b 

and  similarly  for  strain  £.  For  elastic  behavior,  Eq.  (G.ll)  shows  that 


~b  ->■ 

a  =  2Ge 


(G . 16) 


so  that  the  two  vectors  are  coaxial.  The  strain  vectors  are  illustrated 
in  Figure  G.l  and  we  can  imagine  a  corresponding  stress  diagram  with  the 
same  directions,  but  magnified  by  2G.  An  initial  yield  surface  is  shown 

k  _ 

as  the  ellipse  defined  by  the  elastic  strain  corresponding  to  O  =  Y  . 

o  o 

The  equation  of  the  ellipse  is  given  by  Eq .  (G.4d)  and  (G.ll). 


,  'E,  2  ,  ,  „Es  2  .E  -E 

<h  >  +  (e2  >  +  £1  E2 


12G 


(G . 17) 


Now  strain  increments  are  added  to  the  components  of  the  elastic 
strain  deviator  tensor  defining  point  A  to  obtain  a  new  tensor  with 
components  e 

ij 


£ j .  +  Ae 

Uo  ij 


(G.18) 


In  three-dimensional  principal  stress  space  the  yield  surface  is  a 
cylinder  with  its  axis  equiangular  to  the  three  principal  directions 
and  with  radius  /2/3  Y.  In  principal  deviator  stress  space,  the  yield 
locus  is  the  circle  on  this  cylinder  with  the  center  at  the  origin. 

When  viewed  parallel  to  the  third  axis,  the  circle  appears  as  an  ellipse 
in  the  1,  2  plane. 
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MA-6802-14 


FIGURE  G.1  VECTORIAL  REPRESENTATION  OF  PRINCIPAL  STRAINS  DURING 
AN  INTERVAL  OF  PLASTIC  FLOW  WITH  WORK  HARDENING 
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where  none  of  these  tensors  is  necessarily  oriented  in  such  a  way  that 
the  components  are  principal.  When  the  new  total  strain  tensor  is 
diagonalized  to  obtain  the  principal  deviator  strains,  they  define  a 
new  point  C.  (We  take  C  to  be  outside  the  yield  surface  to  illustrate 
yielding.)  Because  of  the  diagonaliza tions  involved  in  proceeding  from 
point  A  to  C,  a  vector  from  point  A  to  C  does  not  have  a  simple  relation 
to  the  strain  increment  tensor. 

The  new  elastic  strain  state  (and  stress  state)  is  given  by  the 


vector  OB  which  terminates  on  a  yield  surface  which  has  expanded  because 
of  the  work  hardening.  We  can  determine  the  coordinates  of  the  point  B 
by  using  the  facts  that 

•  The  elastic  strain  vector  is  coaxial  with  the  stress  vector 


and  has  amplitude  given  by  Eq .  (G.16) 


•  The  plastic  strain  increment  vector  is  coaxial  with  the  stress. 
Then  the  plastic  strain  increment  is 


-*■  CT 


(G.19) 


where  a  is  the  vector  OB  and  is  proportional  to  the  current  yield  value. 
With  the  aid  of  Eqs .  (G.16)  and  (G.14),  Eq .  (G.19)  can  be  transformed  to 
a  scalar  equation  because  all  the  vectors  are  co-axial 


(G . 20) 


Here  we  used  the  facts  derived  from  Eqs.  (G.4b)  and  (G.5b)  that 


and 


(G.21) 


Solving  for  Ae  provides 


-P 


3Ge  —  o 


Ae 


o 


(G . 22) 


M  +  3G 
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_p 

With  Ae  known,  the  yield  value  can  be  found  from  Eq .  (G .  14).  The  elastic 
strain  is 


-E 
E  - 


and  the  individual  strains  and  stresses  are 


O .  . 

iJ 


-E 

e 


(G. 23) 


(G. 24) 


(G. 25) 


where 


(G.26) 


and  0N  is  calculated  from  the  using  equations  of  the  same  form  as 

Eq.  (G.4).  With  the  aid  of  Eqs.  (G.16)  and  (G.22),  the  stresses  may  also 
be  evaluated  as 


A 

a. . 

ij 


M  +  3G  % 
-N 

_ a_ 

M  +  3G 


(G.27) 


Normally  in  wave  propagation  calculations,  the  strains  are  computed 
at  each  step  but  not  stored.  From  the  strains,  new  stresses  are  computed 
and  stored  until  the  next  cycle.  Equations  (G.25)  and  (G.26)  are  the 
only  ones  needed  for  perfect  plasticity  model  calculations.  For  linear 
work  hardening,  Eqs.  (G.25)  and  (G.27)  are  required  and  a  yield  value 
must  be  stored  for  each  cell. 

The  individual  plastic  strain  increments  are  obtained  by  inverting 
Eq.  G.13  and  using  the  deviator  stress  from  Eq .  G.25  or  G.26. 


3dep 


o' . 
ij 


Note  that  the  plastic  strain  increments  are  not  necessarily  proportional 
to  the  applied  strain  increments. 
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The  foregoing  relations  are  simplified  for  the  cases  of  one-dimensional 
flow  in  Appendix  F. 

The  preceding  equations  are  valid  whenever  the  change  in  direction 
of  a  is  small  in  an  increment.  This  restriction  arises  because  de  is 

calculated  as  if  it  were  proportional  to  and  in  the  direction  of  the 

-*  .  ->p 

final  values  of  a  in  the  increment.  In  a  more  accurate  calculation  d£ 

would  be  directed  toward  an  average  a  during  the  increment.  However, 

for  most  calculations  with  solids  this  latter  refinement  is  not  necessary. 

Strain-Rate  Effects 

The  linear-viscous  model  for  strain-rate  effects  is  used  here. 
Initially,  the  analysis  is  developed  for  the  case  of  pure  shear  and  then 
transformed  to  the  multidimensional  case.  In  terms  of  shear  stress  T, 
the  stress-strain  relation  is 


=  c  _ 

9t  3t  T 


(G. 28) 


where  T  is  the  time  constant,  y  is  the  shear  strain,  and  Y  is  the 
yield  stress  in  shear.  With  this  form,  a  very  rapid  loading  proceeds 
elastically,  because  the  first  two  terms  dominate.  For  gradual  loading, 
T  must  remain  near  in  the  plastic  range,  so  the  behavior  is  like 
rate-independent  plastic  flow.  At  intermediate  rates,  an  initial  over¬ 
shoot  of  x  above  Y^_  occurs,  and  then  x  gradually  reduces  to  Y^_ .  For 
computational  purposes,  we  consider  a  short  time  interval,  At,  over 
which  the  strain  rate  is  known  and  constant.  The  shear  stress  at  any 
time,  t,  in  the  interval  is  obtained  by  integrating  Eq .  (G,28) 

T  =  X1e~t/T  +  (GyT  +  Y  ) (1  -  e_t/T)  (G.29) 


where  T  is  the  shear  stress  at  the  beginning  of  the  interval. 

The  analogous  calculation  is  performed  for  a  multidimensional  flow 
by  casting  Eq .  (G.28)  in  the  following  form. 
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(G.30) 


d o'  . 

_il  = 

dt 


As  in  Eq.  (G.28),  the  first  term  on  the  right-hand  side  is  the  elastic 
relation.  The  second  term  represents  the  excess  stress  above  the  static 
yield  value;  this  excess  is  driving  the  rate  process.  The  static  yield 
stress  in  the  ij  direction  is  obtained  from  Eq.  (G.13)  as  2Yde?^ /3de^ . 

Equation  (G.30)  is  then  integrated,  holding  all  strain  rates  constant 
in  the  interval: 


o' .  =  o' .  + 

ij  ijo 


-a . . 

IJO 


2Yde? . 

+  _ LI 

3dep 


+  2GT  d£jj 
dt 


~(t  -  t  )/T 
e  o 

(G *31) 


where  o'.  and  t  are  deviator  stress  and  time  at  the  beginning  of  the 
ijo  o 

interval.  Equation  (G.23)  can  be  evaluated  for  a  time  step  if  an 

estimate  of  de?./de^  can  be  obtained  from  Eq .  (G.13).  In  our  calculations, 

ij 

the  first  estimate  is 


2de? . 
1] 


3de 


a . . 

-N 

a 


(G.32) 


where  the  stress  quantities  are  computed  elastically.  Subsequent 

estimates  are  based  on  the  results  of  the  evaluation  of  o',  from  Eq .  (G.31). 

1J 

Equation  (G.32)  represents  a  good  approximation  when  only  small  changes 
are  evident  in  the  relative  importance  of  the  components  of  the  stress 
tensor,  that  is,  when  only  small  changes  occur  in  the  principal  stress 
d irec tions . 
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Appendix  H 


INSERTION  PROCEDURE 


As  new  material  models  are  generated,  they  can  be  added  to  SRI  PUFF 
for  performing  wave  propagation  calculations.  This  appendix  describes 
the  procedure  for  inserting  material  model  subroutines. 


A  wave  propagation  code  normally  has  four  main  categories  of 
operations:  reading  the  input  data,  initializing  a  finite  difference  grid, 
performing  calculations  for  each  time  increment  at  each  grid  point,  and 
printing  the  computed  information.  A  material  model  subroutine  may  be 
involved  in  all  or  some  of  these  operations.  Call  statements  must  be 
provided  in  SRI  PUFF  at  appropriate  locations  to  accomplish  these  tasks. 
Also  the  new  subroutine  should  be  provided  with  separate  sections  for 
each  operation  and  an  indicator  to  show  which  operation  to  perform.  For 
example,  in  SHEAR2  the  formal  parameter  NCALL  indicates  the  operation 
required,  as  follows: 


NCALL  =  0  Initialize  the  routine  and  read  data  for  one  material 

1  Read  data  for  one  material 

2  Calculate  stresses  and  damage 

3  Calculate  stresses  and  damage,  and  print  results 

4  Print  results  only. 

The  calls  for  NCALL  =  0  and  1  are  in  GENRAT.  There,  NCALL  is  LSUB(15), 
a  parameter  that  is  initially  zero.  After  the  first  call,  LSUB(15)  is 
set  to  1.  For  NCALL  =  2  and  3,  the  call  statement  is  in  HSTRESS.  Other 
calling  strategies  are  also  possible.  For  example,  BFRACT  is  initialized 
on  the  first  call  from  HSTRESS;  there  are  no  other  calls.  EXPLODE  is 
called  from  GENRAT  to  read  data  and  then  called  for  each  cell  during 
the  layout  to  initialize  array  variables.  During  propagation  calculations, 
EXPLODE  is  also  called  by  HSTRESS. 
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At  the  point  of  insertion  of  the  call  statement,  four  elements  are 
provided . 

(1)  The  appropriate  branching  statements  are  needed 
to  switch  to  the  new  model  when  it  is  required. 

For  SHEAR2,  it  was  decided  to  treat  the  model  as 

a  fracture  routine  and  designate  it  by  NFR(M)  =  3. 

Then  the  available  branching  statements  in  GENRAT 
and  HS TRESS  were  amplified  to  include  one  more 
branch. 

(2)  Variables  must  be  initialized,  calibrated,  or  given 
sign  changes  just  preceding  the  call  statement. 

(3)  The  call  statement  is  provided. 

(4)  Some  variables  may  need  to  be  reset  following  the 
calculations  in  the  routine.  Then  a  jump  is  pro¬ 
vided  to  the  appropriate  section  of  HSTRESS  or 
GENRAT  to  continue  the  calculation. 

Items  (2),  (3),  and  (4)  are  discussed  further  below  following  introduction 
of  a  call  statement. 

A  sample  call  statement  for  SHEAR 2  is  listed  here  as  it  appears  in 
HSTRESS,  but  the  same  call  can  be  used  in  GENRAT. 

CALL  SHEAR2  (NCALL,  IN,  M,  J,  J,  H(J,3),  SX,  SY,  SZ,  TXY ,  PHL(J) , 
COM(L) ,  DH,  DOLD,  DT,  EH,  EOLD ,  C0M(L+1) ,  EMELT(M,1) ,  C0M(L+2) ,  EX,  EY, 

EZ,  EXY ,  F,  YHL(J) ,  C0M(L+3) ,  ROT,  DROT,  ESC,  C0M(L+4)).  Because  SHEAR 2 
represents  a  fairly  complex  case,  this  call  statement  will  be  discussed 
in  detail. 

The  initialization  of  NCALL  for  use  in  GENRAT  was  described  above. 

For  HSTRESS,  NCALL  is  initialized  just  before  the  call  statement.  NCALL 
is  set  to  2  normally,  but  it  is  set  to  3  on  cycles  when  an  EDIT  will  occur. 
The  parameter  IN  is  the  file  containing  input  data.  Normally  IN  is  5  but 
may  be  reset  in  GENRAT  to  4  for  a  special  data  file.  The  coordinate  number 
J  appears  twice  because  the  SHEAR2  subroutine  is  also  used  in  two- 
dimensional  calculations  where  two  indices  are  needed.  The  stress 
components  SX,  SY,  SZ,  TXY  are  positive  in  tension  in  HSTRESS,  although 
the  array  quantities  SHL,  PHL,  SDT,  and  SDH  are  positive  in  compression. 

If  necessary,  sign  and  magnitude  changes  can  be  made  in  the  stresses  just 
preceding  the  call  statement.  The  strain  quantities  EX,  EY,  EZ,  EXY  are 
also  positive  in  tension.  In  SHEAR2  most  of  the  material  properties  are 

ISO 


inserted  in  two  large  arrays:  ESC  and  TSR.  The  ESC  array,  listed  in 
Table  H.l,  is  for  the  usual  equation  of  state  parameters,  whereas  TSR 
is  for  the  special  fracture  parameters.  The  rotation  parameter  ROT  is 
zeroed  before  the  call  are  stored  in  the  COM  array,  beginning  at  location 
L  =  LVAR(J) .  The  use  of  COM  and  LVAR  is  described  in  Appendix  C. 

Following  insertion  of  a  new  material  model,  it  is  a  good  plan  to 
run  a  simple  problem  with  frequent  EDITs  to  determine  whether  the 
routine  is  performing  satisfactorily. 


Table  H.l 

MATERIAL  PARAMETER  ARRAY  ESC 


No. 

1 

2 

3,4 


5 

6 
7 
9 

10 

Notes 


Definition 

3 

Original  density,  g/cm 

2 

Bulk  modulus  (C),  dyn/cm 
D  and  S  in  the  pressure  equation: 

2  3 

P  =  Cy  +  Dy  +  Sy 

where  y  =  density/ESC  (M,l)  -  1 

2 

Shear  modulus  (G),  dyn/cm 

2  3 

YADD,  work  hardening  modulus,  dyn/cm  /(g/cm  ) 

3 

Initial  solid  density,  g/cm 
Griineisen  ratio 

2 

Initial  yield  strength,  dyn/cm 


Array  dimension  is  ESC  (6,20)  with  the  first  subscript  for  material 
number  and  the  second  for  property  number  (the  number  listed  above). 
Thus  ESC  (M,5)  is  the  shear  modulus  for  material  M.  The  ESC  array  is 
initialized  in  GENRAT  at  the  end  of  the  materials  loop. 


181 


Appendix  I 


LISTING  OF  SRI  PUFF  8 


The  following  listing  contains  all  the  routines  currently  used  with 
PUFF.  The  main  program  is  given  first,  with  all  the  subroutines  following 
in  alphabetical  order.  Included  are  SRI  PUFF8,  BANDRLX,  BAUSCHI,  BECOM, 
BEMOD,  BFRACT,  CAP1,  DEPOS,  DFRACT,  EDIT,  EOSTAB,  EPLAS ,  EQST,  EQSTPF , 

ESA,  EXPLODE,  EXTRA,  FMELT ,  GENRAT,  GRAY,  HAFSTEP,  HDATA,  HSTRESS ,  HYDRO, 
HYPO,  PEST,  POREQST,  PORHOLT,  PRESCR,  REBAR,  REDR,  RELAX,  REZONE,  SCATTO, 
SCRIBE,  SHEAR2 ,  SIGMAT,  SSCALH,  STORR,  STRES2 ,  and  TSQE.  A  brief  description 
of  each  subroutine  and  references  for  the  material  models  are  given  in 
SECTION  2. 


183 


SUBROUTINE  SRIPUFF 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 


c 

c 

100 


PROGRAM  SRIPUFF ( INPUT* OUTPUT » TAPE 5* INPUT »TAPE6=OUTPUT»TAPE3=2500» 
I  TAPE4,TAPE7,TAPE2=400) 

SRI  PUFF  8,  VERSION  OF  OCTOBER  1975 

WRITTEN  AT  STANFORD  RESEARCH  INSTITUTE  8Y  L.  SEAMAN 
CODE  HANDLES  FRACTURING.  EXPLOSIVES.  POROUS  MATERIALS, 
BAUSCHINGER  EFFECT,  AND  STRESS  RELAXATION  IN  RADIATION  OR 
IMPACT  PROBLEMS. 


MAIN  PROGRAM  *  *  * 

*  CALLS  GENRAT  TO  READ  DATA  AND 

*  CALLS  HYDRO  FOR  EACH  CYCLE  OF 

*  SETS  TIME  STEP 

*  CALLS  EDIT  AND  REZONE  AS  REQUIRED 

*  CALLS  SCRIBE  TO  STORE  RESULTS  AND 


INITIALIZE  ARRAYS 
CALCULATIONS 


FOR  TERMINAL  PRINTOUT 


INTEGER  H, POROUS. PRESS, R INTER, SOL  ID, SPALL 
REAL  MATL»NEM,NET»NEMH,NETH 
MISCELLANEOUS 

COMMON  AZERO(l) , CEF , CKS , DA VG , DELT IM , D ISCPT ( 1 0 ) , DOLD.DRHO.DTMAX, 

1  DTMIN,DTN,DTNh,DU,DX,EOLD,F,FAC,FIRST, J. JCYCS. JINIT, 

2  JFIN.JREZONdS) , JSMaX, JSTAR, JTS.LSUB (30) ,M,MAXPR(30) .n.ncycs, 

3  NEDIT»NPERN,NR,NREZ0N,NSCRB(6>  »nseprat,nspall»ntedt, 

4  NTEX.NTR (15) .P0LD.P6 (20) ,R (30) ,RLAST,SLAST,SMAX,TEDIT (50) , 

5  TF,TIME,TJ,TREZ0N,TS,T6 (20) , UL AST , UOLD , UZERO , XL AST , XNOW , XOLD 
I  ,XJDIT(20) 

HALFSTEP  VALUES 

COMMON  DH,DHLAST»DUH,EH»PH,RH,RHLAST,SH,SHLAST,UH,UHLAST,XH,XHLASTPUFC0M13 


SRIPUFF  2 
SRIPUFF3 
SRIPUFF  4 
SRIPUFF5 
SRIPUFFb 
SR  I  PUFF  7 
SR  I PUFFfi 
SRIPUF  F 9 
SRIPUFlO 
SRIPUF I  I 
SRIPUF  12 
SRIPUF 1 3 
SRIPUF  1 4 
SRIPUF IS 
SRIPUF16 
SRIPUF17 
PUF COM  2 
PUF  COM 
PUFCOM 
PUF  COM 
PUF  COM 
PUF  COM 
PUF  COM 
PUFcOm 
PUF  COM  1 o 
PUFCOM1 1 
PUF  COM  1 2 


.NEMH.NETH 

CONDITION  INDICATORS 

COMMON  I NF, L I NTER, MI RROR, NORMAL, POROUS, PRESS, RINTER. SOL  ID, SPALL 
CELL  LAYOUT 

COMMON  DXX (30 ) »JBND(30) »JMAT(30) .NAUTO.MATL (6,2) .NLAYER.NMTRLS, 
1  THK ( 30 ) 


PUFCOM 1 4 
PUF  COM  1 5 
PUFCO^l 6 
PUFCOM 1 7 
PUFCOM 1 8 
PUF  COM  1 y 
PUF  COM20 

COORDINATE  ARRAYS  C00RDC02 

COMMON/COORD/X (200) »X0(200> ,CHL(200) ,DHL(200) ,DPDD(200)  ,DPDE(200) .C00RDC03 

1  EHLI200) *H ( 200  *  3) ,NEM(200) , NET (200) ,PHL(200) ,RHL(200) ,SDT(200>  *  COORDCO4 

2  SHLI200) ,T(200) »U(200) »YHL(200) ,ZHL(200)  COORDCOs 

COMMON  /RAD/  SSTOP ( 5 ) , ST ART ( 5 ) , SDURM , SSTOPM , NSPEC , SS J , JSS , IPLOT ( 4 ) RADCOM  2 


C 

C 

200 

C 

205 

210 

C 

C 


C 

c 

304 


1  , XMAX ( 4 ) , XMIN ( 4 ) ,YMAX (4) , YM IN ( 4 ) » I A ( 7 ) , I  TITLE (24) .NARZ.TARZ 


CALL  SECOND (FIRST)  $  XINrFlRST 
CALL  GENRAT 

QUICK  STOP  FOR  PROBLEM  LAYOUT  ONLY 
IF  (JCYCS  ,LE.  0)  SO  TO  100 
NpErNsMAXO (NpERN, 1 ) 

CN=NCYCS=NPERN  s  IT=MIN0(0,NTEDT-1) 
N=NR=1 


$  NT=0  $  SF=0.8 


CALCULATE  AND  STORE  HYDRODYNAMIC  DATA 
CALL  HYDRO 

XINL=XIN  $  CALL  SECOND(XIN)  $  DELTIMsXIN-XINL 
PERIODIC  EDITS,  PRINTS 
IF  (MOD ( N,  25)  ,EQ.  0)  205,210 
C AL T I M=X IN-FIRST 

WRITE (6,889) N, JSTAR, TIME, CALTIM, JTS.OTNH.SMAX, JSMAX 
IF  (MOD (N.NEDIT)  »EQ,  0  .AND.  N  ,NE.  JCYCS)  CALL  EDIT 
IF  (LSUB (7)  .EQ.  1)  GO  TO  390 

STORE  DATA  IN  BUFFER 
CALL  STORR 
JTS*MOD ( JTS, 1000) 

STOP  PARAMETERS 
IF  (TIME  , LT,  TS)  304,400 
IF  (N  ,EQ.  JCYCS)  400,305 


R AUCOM  3 
SRIPUF21 
SRIPUF  22 
SR  I PUF  23 
SRIPUF24 
SRIPUF25 
SRIPUF26 
SRIPUF27 
SRIPUF28 
SR IPUF29 
SRIPUF30 
SRIPUF31 
SRIPUF'32 
SR  I  PUF'33 
SR  I PUF34 
SRIPUF35 
SRIPUF  36 
SRIPUF  37 
SRIPUF38 
SR  I PUF  39 
SRlPUf 40 
SRIPUF  4  I 
SRIPUF  42 
SRI PUF  4  3 
SRIPUF44 
SRIPUF  45 
SR  I PUF  46 
SRIPUF47 
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SUBROUTINE  SRIPUFF  (Concluded) 


305 

C 

c 

39  0 
400 


C 

C 

C 

500 


510 

530 

C 

c 


c 

c 

534 

535 


537 

538 
540 
545 
550 
555 

560 

565 

C 

840 


841 

889 


IF  (X(JSMAX)  -  CKS)  500,400,400 

ERROR  FINISH 
N=N- 1 

WRITE  (6,841) 

WRITE  (6*840)  N, JCYCS,TIME,TS,X ( JSMAX) *CKS,LSUB (7) ,DTNH 

lsub ( 7 ) = i  s  call  edit  $  call  storr  $  call  scribe 

PROGRAM  HALTS  ON  COMPLETION  OF  ALL  OATA  DECKS 

GO  TO  100 

TIME  STEP  CALCULATION 

DTNH=AMINI (  SF*DTM I N , AMAX 1 ( 1 , 2*DTNH , . 035*SF*DT MI N ) ) 

IF  (NSPEC  ,EQ.  o  .OR.  SDURM  ,EO.  1.)  GO  TO  530 
SOURM  =  l  , 


SR  I PUF  46 
SRIPUF  49 
SRIPUf  60 
SRIPUFbi 
SMIPUF52 
SRIPUF  53 
SR  I PUF  54 
SRIPUF55 
SR  I PUF  56 
SR IPUF57 
SRIPUFS8 
SRIPUF59 
SR  I PUF  6  0 
SRIPUF61 


DO  510  NS=1 , NSPEC  SR 

IF  (TIME+DTNH  ,GT.  START(NS)  .ANO.  TIME  .LT.  SSTOP(NS))  DTNH  =  SR 
I  AM  INI ( DTNH, AM AX  1 (START ( NS ) -T I  ME , 0 . ) ♦ 0 . 03* < SSTOP < NS > -ST  ART ( NS > ) )  SR 
IF  <TIME-.5*DTN  .LT.  SSTOP(NS))  SDURM*0.  SR 

CONTINUE  SR 

CN=NCYCS=NPERN  SR 

SR 

PERIODIC  REZONE  SR 

IF  ( NREZON  , GE •  0)  GO  TO  534  SR 

IF  (TIME  .LT.  TREZON)  GO  TO  534  SR 

IF  ( OTNH  .GE.  DTMAX)  GO  TO  534  SR 

ENaRZ=NARZ  $  ENR=NN  SR 

IF  (ENARZ*TaRZ  .NE.  0.  .AND.  ENR  .GT.ENARZ  .AND.  TIME  .GT.  TARZJGOSR 
1  TO  534  SR 

IF  (NR  .EQ.  1)  JCR=N  S« 

IF  (N  .LT.  JCR+ (NR-1 ) *IABS (NREZON) )  GO  TO  534  SR 

CALL  EDIT  SR 

CALL  REZONE  $  NR=NR+ 1  SR 


IPUF62 
IPUF63 
I P  U  F  6  4 
IPUF65 
I PUF  66 
I P  U  F  6  7 

IPUFbH 
I P  U  F  b  9 
IPUF  70 
IPUF7I 
I PUF  72 
I  PUF  7  3 
IPUF  74 
I PUF  75 
IPUF  7  6 
IPUF  77 
IPUF  78 
IPUF  79 


TIME  EDIT  AND  REZONE  CALL 
IF  (IT)  560,550,535 
CALL  EDIT  $NT=NT*I 
IF  (NREZON  .LE.  0)  GO  TO  538 
IF  (NT  .EQ.  NTH (NR) )  537,538 
CALL  REZONE  $  NR=NR+1 

IF  (NT  .EQ.  NTEDT)  540*545 
I T  =  —  1  S  GO  TO  560 
I  T  =  0 

IF  <TIME  +  CN*DTNH  .LT.  TED  I T ( NT* 1 ) )  560*555 
NCYCS=(TEOIT(NT+I)-TIME)/OTNH+i  $  CN=NCYCS 
DTNH=AMAX1 ( (TEDIT(NT+I)-TIME)/CN*0.1*DTNH)  $  I T= 1 

N  =  N+  1 

IF  (DTNH  .GE.  1.E-I4)  200*565 
N*N-1  $  GO  TO  400 

FORMAT!/  5H  N  =I4»9H,  JCYCS  =14*  8H,  TIME  =1PE10.3*6H,  TS  = 

1  El  (J  .3  * 12H*  X(JSMaX)  =*E10.3*  7H*  CKS  =*E10.3«10H«  LSUB(7)=I3* 

2  *8H.  OTNH  = lPF 1 0 . 3 ) 

FORMAT  (/4X*28H****  CRITERION  FOR  STOP  **«*> 

FORMAT  (5H  N= 1 5 ♦ 8H ♦  JSTAR=I4*7H,  T I ME= 1  PE  1 0 . 3 . 1 2H *  CALC  TIME  = 

1  F10.3.11H  SECS*  JTS= 1 4 , 7H  DTNH  =  1  PE  I  0 . 3 , 7H  SMAX  =  1  PE  1 0 . 3 , 

2  8H  JSMAX=I4/) 

end 


SR IPUF  80 
SRIPUF  6 1 
SR  I PUF82 
SR IPUF  «3 
SRIPUF84 
SRIPUF65 
SR  I PUF86 
SRIPUF  67 
SRIPUF 68 
SRIPUF m 9 
SRIPUF  9o 
SP IPUF  9 1 
SR IPUF  92 
SR IPUF  9  3 
SRIPUF  94 
SRIPUF95 
SR IPUF  96 
SR  I PUF97 

SR  I PUF98 
SR  I PUF  99 
SRIPU100 
SRIPU101 
SRIPU1 02 
SRIPUl 03 
SR  I PU  1  04 
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SUBROUTINE  BANDRLX 


C 

C 

C 

C 

C 

C 

C 

C 


SUBROUTINE  BANDRLX (ICON.SD, Y1 ,  ORO , COEF , N , J , M , NM , NT , UT , TSR , MUM , 

1  YO.INSR) 

CALLED  BY  «HSTRESS<*  TO  COMPUTE  OEVIATOR  STRESS  FOR  bAND  AND 
GILMAN  RELAXATION  MODELS.  NDS  =  2  AND  3. 

FOLLOWING  TABLE  GIVES  CORRESPONDENCE  OF  COMMON,  BANDRLX  VARIABLES 


c 

COMMON 

NSH 

TSR ( 1 ) 

(?) 

(3) 

(4) 

(5) 

(6) 

NEM 

NET 

c 

BAND 

2 

T 1 

T  2 

BEE 

VM 

GEE 

EPS 

NM 

NT 

c 

GILMAN 

3 

CEE 

PHI 

BEE 

VM 

BNM0 

- 

NM 

GAM 

NOTE.  MEOW=MUM,  YAO=YADO,  INSR=NSR 

NEM  ANO  NET  ARE  MOBILE  ANO  TOTAL  DISLOCATIONS 
GAM  IS  PLASTIC  SHEAR  STRAIN 
JK  IS  A  PATH  INDICATOR 
INPUT  -  ALL  FORMAL  PARAMETERS. 

OUTPUT  -  SO,  ICON,  NM.  NT,  YNOT . 


REAL  NM,NT ,NMO,NTO, MEOW, MUM 
DIMENSION  TSR (b . 30 ) 

Y AO  =  0 .6667  *YO 
YNOT=0.6667*Y1 


T1=TSR(M,15)  $ 
VM=TSR (M , 18 )  $ 
ME0W=2.*MUM 


T2=TSR (M, 16)  $ 

GEE=TSR (M, 19)  $ 


BEE  =  TSR  ( M , 1 7 ) 
EPS=TSR ( M , 20 ) 


ICOR  =  ICON  J  YNOTO=YNOT 
NTO  =  NT  $  NMO  =  NM  $ 


SOO  =  SO 


BANDHLX2 
BANDRLX3 
BANORL  X4 
BANDHLXb 
BANDRLXb 
BANDRLX  7 
BANDRLX8 
BAN0RLX9 
BANDRL10 
BANDKl 1 1 
BANDRL12 
BANDHL1 3 
BANURL14 
BANDRL1S 
BANORL 1 b 
BANDRL 1 7 
BANDRLlH 
BANORL 1 9 
BAN0RL20 
BANDHL21 
BANDRL22 
BANDRL^3 
BAN0RL24 
bANDRL25 
BAl\IORL2b 
BAN0RL27 
BAN0RL28 
BAN0RL29 


NIT  =  4 

L=0  S  ENT=FLOAT (NIT)  $IT=0 

SIGHN  =  SIGN ( 1 . , SOO ) 

IF  (ICON  ,E(J.  2)2,10 

C  INITIAL  CONDITIONS  INSIDE  ELASTIC  ZONE 

2  SD=SDO*COEF 

IF  (ABS  (SO) ,GT. YNOT) 5,66 

C  DEVIATOR  LEAVES  ELASTIC  ZONE.  CALCULATE  RELAXATION 

5  L  =  1 

S  =  .5*  (ABS (SDO  +  COEF ) -YNOT) 

DELT  =  (SD-SIGN (YNOT.COEF) ) / (SO-SOO) *DT 
SIGHN=  SIGN ( 1 , , COEF ) 

ENT= 1 •  $  SD=SDO 


BANDRLJO 
BAN0RL31 
BANOHL32 
BAN0RL33 
BANI)Rl34 
BAN0RL35 
BAN0RL36 
BANORL  37 
BANORL3H 
BANDKL39 
BANDRL40 
BANDRL4 1 
BANDRL42 


C 


C 


C 


16 

17 

C 


19 


C 


GO  TO  40  BANDRL43 

INITIAL  CONDITION  OUTSIDE  OF  ELASTIC  ZONE  BANDRL44 

10  L  =  2  BANDRl'.B 

I  T=  IT* 1  SSDI=S0*C0EF/(2.*ENT)  BANORL46 

S  =  ABS  (SOI ) -YNOT  4  DE'LT  =  OT/ENT  BANDHl47 

IF (S.LE.O. ) IB, 11  BAn0hl4B 


AVERAGE  OEVIATOR  REMAINS  OUTSIOE  ELASTIC  ZONE.  CALCULATE  HEL AX AT  I B AN0RL49 


11  L  =  3 

IF ( SIGHN. EO. SIGN  (1., SOI) >40,17 

13  IF (ABS (SD) .GT. YNOT) 14, 16 

14  L=4 

IF ( SIGN ( 1 . , SD ) .FQ. SIGHN) 15,16 

OEVIATOR  REMAINS  OUTSIOE  ELASTIC  ZONE  AFTER  RELAXATION 

15  L  =  5 

IF (IT. EO. NIT)  62*10 
SO=SDI-COEF/ (2.*ENT) 

L  =  6 

DEVIATOR  REENTERS  ELASTIC  ZONE.  RECALCULATE  RELAXATION 
10  S  =  .5*(ABS(S0)-YN0T>  4YSTAR  =  S I GN ( YNOT , SOO ) 

DELT= ( YSTAR-SO) /COEF*DT 
GO  TO  40 

SD=SD*COEF/ENT*FLOAT (NIT-IT) 

IF  (ABS(SD) .GT.YNOT)21,20 
2C  ICON  =  2 
GO  TO  66 

DEVIATOR  CROSSES  OVER  TO  OPPOSITE  SIDE  OF  ELASTIC  ZONE. 


bANDRLb0 
BAN0RL51 
BAN0RL52 
BAN0RL53 
BANORL34 
BANDRL55 
BAN0RL56 
BANDRL57 
bANDRLSS 
BANORL54 
B ANDRL60 
BANORLb 1 
BAN0RL62 
BANDRLB3 
BANDRL64 
BAN0RL65 
BANDRL66 
BAN0RL67 
RECALCULATES ANORL60 
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SUBROUTINE  BANDRLX  (Concluded) 


21  IF  (SIGNI1 .  ,S0>  ,E0. SIGHN)  GO  TO  62 
SIGHN  =  -SIGHN  $  L=7 
DELT  =  (SO+YSTAR) /COEF«OT 
S  =  .5* ( ABS (SD) -YNOT) 

SD=SD-COEF  $  ENT= 1 . 

40  AWG=4. «BEE/3./S 

IF  ( ARG.GT. 20) 42*43 

42  XPO  =0.  5  60  TO  45 

43  XPO  =  EXP(-ARG) 

4b  GO  TO  (96*51*52) INSR 

C  PERFORM  RELAXATION  CALCULATIONS  -  BAND  MODEL 

51  TP=NT 

NT=NT+ (EPS^GEE^S" (NT-NM) -1 . /T2*NM«XP0) tt0ELT 
NM=NM* (GEE"S« (TP-NM) - ( 1 . /T 1 ♦ 1 . /T2 ) *NM*XPO) »0ELT 
GO  TO  54 

C  PERFORM  RELAXATION  CALCULATIONS  -  GILMAN  MODEL 

52  CEE=T1  S  PH  I  =  T?  $  BNMO=GEE  t  GAM  =  GAMO  =  NT 
NM  =  RNMOtt  (  1  ,  +  CEE*GAM)  <>EXP  ( -PH  I  *GAM ) 

54  SD  =  SO  +  COEF/ENT-l . 333<>MUM«NM» VM»XPO»OELT »S I GHN 

55  GO  TO  (60*19,13,19*96,19*60)L 

60  ICON  =  2-IFIX (SIGN ( 1 . ,SD) ) 

C  RECALCULATE  YIELD  STRENGTH  IN  CASES  OF  STRAIN  HARDENING 

62  YNOT  =  AMIN1 ( ABS (SD) * YNOT ♦ YAO*ABS (DRO) ) 

IF  (YNOT.EU. ABS (SD) )  64.66 

64  I CON=2  $  L=  L*50 

66  CONTINUE 

GO  TO  (96*90*78) INSR 
78  OGAM  =  ABS (SDO+COEF-SD) /2.667/MUM 
NT=GAM=GAM*DGAM 
Y 1  =  1.5  ^ YNOT 
9 c  RETURN 

96  WRITE  (  6.199)  INSP.L 
Y 1  =  1.5  ° YNOT 
RETURN 

199  FORMAT  (25H  ERROR  IN  BANORLX  * INSR  =  I5*SH*  L  =  15) 

ENO 


BANURL69 
BANDRL  70 
B  AM)RL  7  1 
BANDRL  72 
BANDRL  Vi 
BaNDRl  74 
BANDRI  75 
b  A  N IJ  R  L  7  6 
bANDRL77 
BmnDKL  /h 
BANOHL79 
R ANDKl  60 
bANDK  L8 1 
bANljKLd? 
BANUKL6  3 
B  AnL)N  L  84 
BANURLBb 
BANOWL66 

BA)Nj[jBurt7 
BANDKL66 
BANDHL  69 
HANDK L  9  0 
BANURL91 
8AN0Bl9? 
BAN0WL93 
BAN0WL^4 
bANOKL^b 
BANDBu9b 

BANDBL97 
BANDKL9B 
BANDKL99 
BANDB100 
BANDW] 01 
BANDBiO? 
BANDW l 03 
B AWDB 1 04 
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OOO  POO  POOOO  o  •—  o  o  o  o  ooooooooooooooo 


SUBROUTINE  BAUSCHI 


SUBROUTINE  BAUSCHI ( I  NO , SD , OS , YC , YHL . EP . EPM , HT , HC , XP ,  G ) 

ROUTINE  PROVIOES  A  BAUSCHINGER  EFFECT  WHEN  OEVIATOR  CHANGES 
SIGN.  FUNCTION  HAS  THE  FORM  (S/SO)*«N  *  EP/EPM 
IN0=H(J.3).  2  *  COMPRESSION.  0  *  TENSION 

SD  *DEVIATOR  STRESS.  INPUT  AS  SDO.  OUTPUT  AS  SUH  OR  SDJ 
DS  =  CHANGE  IN  OEVIATOR.  SD=SD+DS.  INPUT  AS  ELASTIC  CHANGE 
YC  =NEM.  CURRENT  YIELO.  SET  TO  ZERO  WHEN  SIGN  OF  DEVIATOR  CHANGES 

Y  s  YHL .  YIELO  (USED  AT  2/3ROS  ACTUAL  VALUE) 

EP  =NET().  PLASTIC  STRAIN.  RESET  TO  ZERO  WHEN  OEV.  CHANGES  SIGN 
EPM=TSR ( I ) .  PLASTIC  STRAIN  AT  WHICH  BAUSCHINGER  EFFECT  CEASES 
HT  =TSR(2).  WORK  HARDENING  MODULUS  IN  TENSION 
HC  =TSR ( 3 )  .  WORK  HARDENING  MOOULUS  IN  COMPRESSION 

XP  =TSR(4)=1/N  in  oefining  equation,  exponent 

M  =4/3RDS  ELASTIC  SHEAR  MODULUS.  M=MU  ♦  EXMAT (M, 1 )  «  (D/RHO-1) 
REAL  M 

Y  =  0.6667  *YHL 
M  =  1.333  *  G 

IF  <DS*SD  ,GE.  0.)  GO  TO  100 

*****  begin  route  for  change  in  direction  of  loading  **** 

IF  (SO* (SO+OS)  ,GE.  0.)  GO  TO  400 

STRESS  HAS  CHANGED  SIGN.  PREPARE  FOR  BAUSCHINGER  EFFECT 
IF  (ABS(EP)  .LE.  0.)  GO  TO  100 
YC=EP=0.  S  IND=1*SIGN ( 1 . ,SD*DS)  $ 

*****  BEGIN  ROUTE  FOR  CONTINUEO  LOADING 
BRANCH  TO  ELASTIC  PATH  IF  YIELO  IS  NOT 
00  IF  (ABS(SD*DS)  .LT.  YC)  GO  TO  400 

BRANCH  TO  BAUSCHINGER  PATH  IF  PLASTIC  STRAIN  IS  LESS  THAN  EPM 
IF  (YC  .LT.  Y  .AND.  ABS(EP)  ,LT.  EPM)  GO  TO  300 


GO  TO  300 
IN  SAME  OIRECTION 
EXCEEDED 


*****  LINEAR  WORK  HARDENING  PATHS  «**« 

COMPRESSION 

00  IF  (SD  .LT.  0.)  GO  TO  220 

SD=YC=Y=SD* (OS*HCfM* ( Y-SD) )/(HC*M) 

DEP=(SD*OS-YC)/(M+H)  $  EP=EP*DEP 

YHL  =  1.5  *  Y 

RETURN 

LINEAR  WORK  HARDENING  IN  TENSION 
20  SO=SD* (DS*HT-M* ( Y ♦ SD ) ) /(HT*M) 

YC=Y=-SO 

DEP=(SD*DS-YC)/(M+H)  $  EP=EP*OEP 

YrtL  =  1.5  *  Y 

RETURN 

*****  BAUSCHINGER  -  NONLINEAR  WORK  HARDENING  -  PATH  «**« 

SET  INITIAL  PLASTIC  MOOULUS  AND  WORK  HARDENING  MODULI 
IF  (ABS(EP)  .LT.  l.E-4)  GO  TO  310 
HO= AMIN1 (YC*XP/ABS (EP) .1.E14) 

DEPA=ABS( (SD+DS-SIGN(YC.SD*DS) )/(HO*M) ) 

H0=0,5* (HO* ( YCfHO*DEPA) *XP/ (ABS (Ep) *DEPA) ) 

GO  TO  315 

HO=ABS (SD+DS-SIGN1 YC.SD+OS) ) / ( EPM* ( ABS ( SD+OS ) /Y ) *« ( l./XP) -A6S (EP) 
H  =  HC 

IF  ( SD  +  OS  .LT.  0.)  H  =  HT 
L  =  0 

C  INITIAL  ESTIMATES  OF  -EP-  ANO  -YC- 

DEP= (SO+OS-SIGN ( YC.SD+DS) ) / (HO*M) 

EPABS=ABS (EP+OEP) 

YC  =  Y»AMIN1 (1.. (EPABS/EPM) **XP) ♦H*AMIN1 (ABS (DEP) . AM AX  1 ( 0 . . EP ABS 
1  -EPM)) 

HO=YC*XP/EPABS 
IF  (EPABS  .GT.  EPM)  HO=H 
330  DSE=SIGN (YC.DS)-SD 


300 


310 

315 


B AUSCM 1 2 
BAUSCH I  3 
BAUSCHI4 
BAUSCHlS 
BAUSCHI6 
BAUSCHI r 

BAUSCHI8 
BAUSCH I  9 
BAUSCH10 
BAUSCHI 1 
BAUSCH12 
BAUSCHI 3 
BAUSCH 1 4 
BAUSCnlb 
BAUSCHI 6 
BAUSCHI 7 
BAUSCHlH 
BAUSChIv 
BAUSCH20 
BAUSCH21 
*B AUSCH22 
BAUSCK23 
BAUSCH24 
BAUSCH25 
BAUSCH26 
*BAUSCH27 
BAUSCH2B 
BAUSCH29 
BAUSCH30 
BAUSCH31 
BAUSCH32 
*BAUSCh33 
BAUSCH34 
BAUSCH35 
8AUSCH36 
BAUSCH37 
BAUSCH38 
BAUSCH39 
BAUSCH40 
8 AUSCH4  1 
BAUSCH42 
BAUSCH43 
BAUSCH44 
BAUSCH45 
BAUSCH46 
*B AUSCH4  7 
BAUSCH48 
BAUSCH49 
BAUSCH50 
BAUSChbl 
BAusCh52 
BAUSCH53 
) BAUSCH54 
8 AUSCH55 
BAUSCH56 
BAUSCH57 
BAUSCH5B 
BAUSCH59 
BAUSCH60 
BAUSCH6 1 
BAUSCH62 
BAUSCH63 
BAUSCM64 
BAUSCH65 
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SUBROUTINE  BAUSCHI  (Concluded) 


c 

BEGIN  ITERATIONS  FOR  PLASTIC  STRAIN  AND  YIELD 

BAUSCH66 

L  =  L  ♦  1 

B AUSCH6  7 

DEP?=DEP 

BAUSCM68 

DEP= (DS-DSE* HOLDER) / (HO*M) 

BAUSCH69 

IF  (DEP*DEP?  .LT.  0.)  DEP=DEP2/3. 

BAUSCh  7  0 

EPABS=ABS (EP*DEP> 

BAUSCH71 

YC=Y*AMIN1 ( 1 . . (FPABS/EPM) «*XP) *H*AMIN1 ( ABS (OEP) .AMaXI (0. 

» EPABS  BAUSCH  72 

1  -EPM)) 

BAUSCh  7 3 

HO=YC«XP/EPABS 

HAU5C"74 

IF  (EPABS  .GT.  FPM)  HO=H 

BAUSCH  75 

IF  (L  .GT.  10)  GO  TO  350 

BAUSCH/h 

IF  (ABS  (SIGN (YC.DS) -SD-DSE)  .GT.  1.E6)  GO  TO  330 

BaUSCh 77 

350 

SD=SIGN ( YC.DS) 

BAUSCH  7  8 

Y  =  AMAX 1 (Y.YC) 

BAUSCH  7 9 

EP=EP*DEP 

BAUSCHcin 

YhL  =  1.5  *  Y 

BAUSCHbl 

RETURN 

BAUSCHb? 

C 

-  BAUSCH A  3 

c** 

***  ELASTIC  ROUTE 

ott<M>*bAUSCno4 

400 

SD=SD*DS 

BAUSCmBS 

RETURN 

BAUSCH86 

END 

HAUSCHB7 
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SUBROUTINE  BECOM 


C 


0 


1 


1 

1 


2 


3 


10 


30 


SUBROUTINE  BECOM { D t SDH t DTNP 1 t J ♦ N )  BECOM  2 

COMMON  /S2/  ALFtCOtEENtEENPlfEPNtKS.TAUELtTAUItTAUNtTAUOfVELStVMUfALCOM  2 


Z  AM,  Z  AMUSV  .ZEP.ZEPDSV.ZEPMAXC.ZEPMaXS.ZE'PSAVE.ZTaUY, 

ZTAUYMX 

ALCOM 

3 

DIMENSION  TEMP { 30 ) 

BECOM 

4 

BECOM 

5 

data  alp.  beta,  bob2,  bviob.  cb.  cs. 

EM/ 

BECOM 

6 

4.E13,  5.2E10.1.B9E11,  3.85E9.  2.E-4.  8.86E5, 

6.25/ 

BECOM 

7 

DATA  RBVI.  SM.  SMA.  SMB.  VO/ 

BECOM 

8 

28.2.  C.16.  17.0.  2.3E-8.  1.18E8/ 

BECOM 

9 

RECOM 

10 

**«  INITIALIZATION  OP  PLA6S  AND  CONSTANTS  -  BASED  UPON 

THE 

BECOM 

1  1 

STRESS-STRAIN  PROPERTIES  AT  TIME(N).  *** 

BECOM 

12 

BECOM 

13 

***  KK  .EQ.  0  -  INITIAL  LOADING  PHASE 

BECOM 

14 

KK  .EQ.  1  -  UNLOADING  OR  RELOADING  PHASES 

8EC0M 

15 

BECOM 

16 

C 1 =Z AMUSV 

BECOM 

1  1 

ICONV=0 

BECOM 

18 

ITERT=ITH=PT=1. 

BECOM 

19 

KK  =  n 

BECOM 

20 

SIGNT=SIGN ( 1 . .TAUN) 

BECOM 

21 

IP  (ZEPMAXS  .GT.  0.)  KK= 1 

BECOM 

22 

IP  (KK  .EQ.  1)  GO  TO  2 

BECOM 

23 

SIGNERS I GN ( 1 • . EEN) 

BECOM 

24 

STAUO=SIGNE*TAUO 

BECOM 

25 

STAUI=SIGNE«TAUI 

BECOM 

26 

GO  TO  3 

BECOM 

27 

STAUO=SIGNT*TAUO 

BECOM 

28 

STAUI=SIGNT«TAUI 

BECOM 

29 

BECOM 

30 

***  TRANSPER  TO  EITHER  STATEMENT  90.  WHICH  BEGINS  THE 

CALCULATION 

BECOM 

31 

OP  THE  PLASTIC  STRESS-STRAIN  PROPERTIES  AT  TIME ( N* 

1 ) .  OR  TO 

BECOM 

32 

ONE  OP  THE  SPECIAL  CASES  DETERMINED  BY  THE  STRESS 

ROUTINE.  »»*BECOM 

33 

BECOM 

34 

KSPlsKS+1 

BECOM 

35 

GO  TO  (90.10.20.40.50).  KSP1 

BECOM 

36 

BECOM 

37 

**#  KS  .EQ.  1  -  INITIAL  CROSSING  OP  YIELO  POINT,  TAUO. 

THE: 

BECOM 

38 

PRACT I ON  OF  THE  TIME  STEP  IN  THE  PLASTIC  REGIME  IS 

BECOM 

39 

CALCULATED.  *** 

BECOM 

40 

dECOM 

41 

PT= (TAUEL-STAUO) / (TAUEL-TAUN) 

BECOM 

42 

RECOMPUTE  TAUEL,  USING  UPDaTEO  MODULUS 

BECOM 

43 

Cl = AM  INI  ( Z AMUSV, AM AX  1  (ZAM-ALP°ABS(EENP1 *PT*VELS)  . 1 . )  ) 

BECOM 

44 

TAUEL=C1*EENP1 

BECOM 

45 

PT= (TAUEL-STAUO) / (TAUEL-TAUN) 

BECOM 

46 

Taun=stauo 

BECOM 

47 

ZTAUY  =  ST  AUO 

BECOM 

48 

GO  TO  90 

BECOM 

49 

BECOM 

50 

***  KS  .EQ.  2  -  CROSSING  FROM  POSITIVE  TO  NEGATIVE  TAU 

OR  VICE 

BECOM 

5 1 

VERSA.  CALCULATED  QUANTITIES  ARE  THE  FRACTION  OP  THE  TIME  STEPBECOM 

52 

IN  THE  PLASTIC  REGIME.  THE  PLASTIC  STRAIN  AT  THE  CROSSING 

BECOM 

53 

POINT,  AND  THE  CUMULATIVE  TOTAL  OP  THE  PLASTIC  STRAIN.  *»» 

BECOM 

54 

BECOM 

55 

TAUN=TAUJ=ZTAUY=ZEPDSV=0. 

BECOM 

56 

STAUO=-STAUO 

BECOM 

57 

STAU I  =-ST  AU  I 

BECOM 

58 

SIGNT=-SIGNT 

BECOM 

59 

FT  =  AMAX 1 (0..AMIN1 (1. . -TAUEL/  ( Z AM* VELS ) ) ) 

BECOM 

60 

EPN=2.* (EENP1+PT*VELS) /3. 

BECOM 

61 

ZEPMAXS=ZEPMAXS+ABS (ZEPMAXC-EPN) 

BECOM 

62 

zepmaxc=epn 

BECOM 

63 

IP  (KK.GT •  o)  60  TO  30 

BECOM 

64 

KK=1 

BECOM 

65 

ZEPSAVE=ABS(ZEPMAXC> 

BECOM 

66 

IP  (FT  .GE..001)  GO  TO  90 

BECOM 

67 

EPNP1*EPN 

BECOM 

68 

GO  TO  340 

BECOM 

69 
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SUBROUTINE  BECOM  (Continued) 


C  BECOM 

C  o#*  KS  ,  EO  •  3  -  RELOADING  FROM  AN  ELASTIC  POINT  TO  A  PLASTIC  HECOM 

C  POINT,  THE  FRACTION  OF  THE  TIME  STEP  IN  THE  PLASTIC  REGIME  BECOM 

C  IS  CALCULATED,  ***  BECOM 

C  BECOM 

40  FT= ( TAUEL-ZTAUYMX) / (TAUEL-ZTAUY)  BECOM 

C  RECOMPUTE  TAUEL*  USING  UPDATED  MODULUS  BECOM 

C 1 = AM  INI  ( Z AMUSV  9  AM AX  1  (ZAM-ALF^ABS (EENP1+FT*VELS)  » 1.)  )  BECOM 

TaUEL=C1* (EENPl-l ,b*EPN)  BECOM 

FT= (TAUEL-ZTAUYMX) / (TAUEL-ZTAUY)  B t COM 

ZTAUY=TAUN=ZTAUYMX  bEC0M 

GO  TO  90  HECOM 

C  BECOM 

C  KS  .EO.  4  -  FIRST  ELASTICALLY  CALCULATED  POINT  IN  UNLOADING  BECOM 

C  PHASE.  THE  TAU  AND  TAUY  VERSUS  STRAIN  CURVES  CRuSS  BEFORE  BECOM 

C  TIME (N* 1 ) ,  bECOM 

C  bECOM 

50  IF  (KK  . GT .  0)  GO  TO  54  BECOM 

C  bECOM 

C  ***  UNLOADING  FROM  INITIAL  LOADING  PHASE  BECOM 

C  BECOM 

C  PLASTIC  STRAIN  IN  FIRST  PANT  OF  TIME  STEP  IS  FROM  BECOM 

C  EPDOT  =  4/3*PrtI*PSI/(PHl*PSI )  =  A  BECOM 

DTAU=TAUN-ZTAUY  BECOM 

A=0 .  BECOM 

IF  (ABS(DTAU)  • L T •  1.E7)  GO  TO  52  BECOM 

EPTOT  =  ABS ( ZEPM AXC-EPN )  BECOM 

PH I =S I GNT* AMAX 1 ( 1 . E-6 *  AM I N 1  ( I ,E6 * ABS ( OT AU/ ( VO ♦BE TA»EPTOT*#2 )  )  ) ) **  BtCOM 
1  EM  BECOM 

CALL  BEMOD (KK,Jf SIGHT ,EPN,ANM)  BECOM 

A=1 ,333/ (EM* 1 , ) / ( 1 ./PHI  ♦B0B2/ANM* ( 1 ,/UTAU+l ./ (TAUn+ZTAUY)  BECOM 1 

1  ♦0*2b*(TAUN*ZTAUY)/BVIOb»»2) )  BECOM] 

52  TaUY1=STAU0*SQRT ( 1 . *00# ABS ( ZEPMAXC-EPN-A*DTNPl ) )  BECOM] 

FT=DTAU/ (TAUYl-ZTAUY*Cl<MVELS*1.5*A*DTNPl) )  BECOM 1 

F T  =  AM AX  1  ( 0 . 9  AM I N 1  ( 1 . 9 F T )  )  BtCOM 1 

Ec=EEN-FT*VELS  BECOM] 

EPNPl=EPN*A*DTNPl#FT  BtCOM] 

ZTAUYMX  =  STAUO*SQRT ( 1 ,*CO»A8S ( ZEPMAXC-EPNP ]  )  )  BECOM] 

GO  TO  56  BECOM] 

C  BtCOM 1 

C  ***  UNLOADING  FROM  A  LOADING  PHASE  OTHER  THAN  THE  INIT.  LOADING  BECOM] 

C  BtCOM] 

54  DTAUsT  AUN-ZTAUY  BECOM1 

A=0 •  BtCOM 1 

IF  (ABS(DTAU)  ,LT.  1.E7)  GO  TO  55  BECOMl 

EPTOT= ABS ( ZEPM AXC-EPN)  BECOM] 

PHI=SIGNT»AMA\1 ( 1 , E-6* AMIN  1 ( 1 ,Eb*ABS(f)TAU/(VO*8ETA*EPTOT**2)  ) )  ) **  BECOMl 

1  EM  BECOMl 

CALL  BEMOD (KK, Jf SIGNT.EPN, ANM)  BECOMl 

A» 1 .333/ (EM* 1 . ) / ( 1  ,/PHI  ♦ BOB2/ANM# ( l./DTAU* 1 ,/ ( T  AUN ♦ ZTAUY )  BtCOM 1 

1  *u.25*  (T AUN-ZTAUY  ) /B VI OB*»2)  )  BECOM] 

55  TAUYl*STAUI«(l.-EXP(-SMA*SQRT(ABS(ZEPMAXC-EPN-A*DTNPl) ) ) )  BECOM] 

FTsDTAU/ (TAUY1-ZTAUY*C1* (VELS*1,5*A*DTNP1) )  BECOMl 

FT=AMAX1 (0.9AMIN1 (I.9FT) )  BECOMl 

Ec=EEN-FT*VELS  BECOM] 

.  EPNPl=EPN*A^DTNPl*FT  BECOMl 

ZTAUYMX=TAUN-C1»(FT*VELS*1.5*(EPNP1-EPN) )  BtCOM 1 

C  BECOMl 

C  UPDATE  OF  SHEAR  STRESS  AT  TIME  N*1  BECOMl 

C  BECOMl 

56  ZEPDSVrO.  BECOMl 

ZT AUY=ZTAUYMX-VELS»C1» ( 1 .-FT)  BECOMl 

T  AU J  =  Z  T  AUY  BECOMl 

IF  (TAUJ^ZTAUYMX  .GT.  0.)  GO  TO  340  BECOMl 

KS=2  BECOMl 

Z  T  AUY  MX  =  0 •  BECOM] 

T  AUEL  =  TAUJ  BECOMl 

GO  TO  20  BECOM] 
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71 

72 

7  3 

74 

75 

7b 

7  7 

7  8 

79 

60 

HI 

B  2 

B3 

84 

65 

86 

87 

B8 

89 

90 

91 

92 

93 
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95 

96 

97 

98 

99 

00 

01 

02 

03 

04 

05 
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08 
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16 
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18 

19 
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21 
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SUBROUTINE  BECOM  (Continued) 


C 

c 

c 

c 

90 


C 

200 


205 

C 


262 


265 


267 

268 
270 


275 


280 


***#*«»*«** 

***  BEGIN  ITERATION  LOOP  FOR  STRESS  ANO  PLASTIC  SHEAR  STRAIN 
v 

EPNP 1 =EPN 

EPTOT=ABS (ZEPMAXC-EPN) 

IF  (FT  .LT.  0.)  GO  TO  300 
FTDT=FT*DTNPl 

ftvels=ft*vels 


EPTOT=ABS(ZEPMAXC-EPN-ZEPDSV«FTDT) 

DTAU=TAUN-ZTAUY 

PHI=SIGNT*AMAX1 (1.E-6.AMIN1 ( 1  .  E6 . ASS < DTAU/ < VO +  BET A*  EPTOT**2> ) ) 
1  EM 

Tl3=DTAU/BVIOB 

PSI=0. 

IF  ( ABS ( T 1 3 )  .LT.  .01)  GO  TO  205 

T 14= (TAUN+ZTAUY) /BVIOB 

CALL  BEMOD (KK,J,SIGNT,EPN. ANM) 

PSI  =  RBVI/ANM* (Tl3/ (SORT (Tl3**2+1  . ) -1 . ) +T14/ < SQRT  < T 1 4**2 ♦ 1 . ) -1 . ) 
EPDO=l ./ (PSI+ 1 ./PHI ) 

NEXT  estimate  of  plastic  strain  IS  BASED  ON  EPDO 
EPNP1=EPN+EPD0*FTDT 
EPNSUM=EPN 

NTIMES=MAX1 ( 1 . *  AM 1 N 1 (5.«3.*AUS(EPNPl-EPN)/(ABS(EPT0T)  +  l.E-12) ) ) 
IF  (ABS(EPTOT)  .LT.  l.E-12)  NTIMES=5 
DEPB=DEPA=ZEPDSV*FTDT/NTIMES 


DEPB=DEPA-SIGN(1,E-12.VELS) 

DEPAA=EPDO*FTDT/NTIMES 
DO  280  NNN=1,NTIMES 
ITERT=1 

EPT0T=ABS (ZEPMAXC-EPNSUM-0 .5*DEPB) 

EEC=EENP1+ ( 1 .- (NNN-0.5) /NTIMES) *FTVELS 
Cl*AMINl (ZAMUSV.AMAX1 (ZAM-ALF*ABS  (EEC) *  1  .  )  ) 

TAUJ*C1* (EEC-1 .5*<EPNSUM*0.5*DEPB) ) 

IF  (KK  ,EQ.  0)  TAUYJ=STAUO*SQRT(l.*CO*EPTOT) 

IF  (KK  .EQ.  1)  TAUYJ  =  STAUI*(l.-EXP(-SMA»SURT(EPTOT)  )  ) 
DTAU=TAUJ-TAUYJ 

PHI=SIGNT*AMAX1 (1.E-6.AMIN1 (l.E6*ABS(DTAU/(V0+BETA*EPT0T**2) ) ) ) 
1  EM 

T13=DTAU/BVIOB 

PSI=0.  S  IF  (ABS ( T 1 3 )  .LT.  .01)  GO  TO  265 
T 1 4= (TAUJ+TAUYJ) /BVIOB 

CALL  BEMOD (KK, J, SI GNT . EPNSUM+ o . 5*DEPB . ANM) 

PSI=RBVI/ANM»(Tl3/(SQRT(Tl3**2*l.)-l.) *T14/ ( SORT ( T 14**2+  1  .)-  1  .  ) 
EPDJ=1 ./ (PSI +1 ./PHI ) 

DEPBB=EPDJ*FTDT/NTIMES 

DEP= (DEPA*DEPBB-DEPAA*DEPB) / ( DEPBB- JEPA A+DEP A-OEPB+ 1 . E- 1 2 ) 


L0C=265 
EPNP1»EPN+DEP 
IF  (ABS (DEP-DEPBB) 

1  .LT.  l.E-10)  GO 
IF  (ITERT  .GE.  20) 

IF  (ITERT  .EQ.  D 
IF  (ABS (DEPB-DEP) 

1  GO  TO  270 
GO  TO  268 
DEP=DEPBB 

DEPA=DEPB  %  DEPAA=DEPBB 

ITERT=ITERT+l 

DEPB=DEP 


.LT.  0.02*ABS(DEPBB)  .OR.  ABS ( DEPB-DEPBB ) 
TO  275 
GO  TO  295 
GO  TO  267 

.GT.  ABS (DEPA-DEP)  .AND.  MOD ( I TERT «  3 )  • NE . 


GO  TO  262 

DEPA*DEPB  $  DEPAA=DEPBB 
EPNSUM=EPNSUM+DEP 

IF  (ITERT  .EQ.  1  .AND.  DEP  .EQ.  0.)  EPNSUM=EPNSUM+DEPBB 
CONTINUE 
EPNP 1 =EPNSuM 
GO  TO  300 


3) 


BECOM 1 38 
BECOM 139 
BECOM  14  0 
BECOM 141 
BECOM  142 
BECOM 143 
BECOM 144 
BECOM 1 45 
BECOM 1 46 
BECOM 1 4  7 
BECOM 1 48 
BECOM 1 49 
) **BECOM 1 5  0 
BECOM  j  B 1 
BECOMl 52 
BECOM 153 
BECOM 1 54 
BECOM 1 55 
BECOM 156 
)  BECOM 1 57 
BECOMl 5b 
BECOM 1 59 
BECOM 160 
BECOMl 6 1 
BECOM 1 62 
BECOM 163 
BECOM 164 
BECOMl 65 
BECOMl 66 
BECOM 1 67 
BECOM 1 68 
BECOMl 69 
BECOM 170 
BECOM 1 7 1 
BECOMl 72 
BECOMl 73 
BECOMl 74 
BECOM 1 75 
**  BECOM 1 76 
BECOMl 77 
BECOM 1 78 
BECOM 179 
BECOM 180 
BECOM 1 6 1 
)  BECOM 1 82 
BECOM1B3 
BECOM 1 84 
BECOM 1 85 
BECOMl 86 
BECOM 1 87 
BECOM ] B8 
BECOM 189 
BECOM 190 
BECOM 191 
BECOM l 92 
BECOM 1 93 
BECOM 1 94 
BECOMl 95 
BECOMl 96 
BECOM 197 
BECOM 1 9B 
BECOMl 99 
BECOM200 
BECOM201 
6ECOM202 
BECOM/03 
BECOM204 
BEC0MJ05 
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SUBROUTINE  BECOM  (Concluded) 


295  L0C=295 

EPNPl=EPN*EPDO*FTDT 

PRINT  1295*  LOC.J*N,EPNPl.DEPA*DEPB*OtPAA.DEPBB.EPN.EPOO.FTOT 
1295  FORMAT!*  L0C=*l4**  J*N=*2I4**.  EPNP 1 =* 1P9E 1 1 . 3 ) 

300  CONTINUE 

C 1  =  AM  I Nl ( Z AMUSV  « AMAX 1 < ZAM-ALF*ABS (EENP 1 ) *  1 . )  ) 

TAUJ=C1* (EENPl-i ,5*EPNP1 ) 

EPTOT=ABS (ZEPMAXC-EPNPl ) 

IF  (KK  .EQ.  0)  TAUYJ=STAUO*SQRT < 1 ,*CO*EPTOT) 

IF  (KK  .EQ.  1)  TAUYJ=STAUI»( l.-EXP <-SMA*SQRT (EPTOT) ) ) 

C 

310  IF  (ABS(TAUJ)  .GT.  ABS(TAUYJ))  GO  TO  330 
KS  =  4 

GO  TO  50 
C 

330  IF  (ABS(TAUYJ)  .LE.  0.)  TAUY JsSIGN < 1 . , TAUJ) 

ZTAUY=TAUYJ 
ZEPDSV=EPDJ 
340  SDH=4.*TAUJ/3. 

ZEP=EPNP 1 
C 

RF  turn 

c 

END 


BtCOMpOfe 
BECOMpO  7 
dECOMp  o  8 
BECOM209 
BECOMp 1 o 
BECOMpl  1 
BECOMp 1 2 
BECOMp 1 3 
BEC0M214 
BECOMp lb 
BLC0M216 
BECOM217 
BECOMp 1 8 
d  E  C  O  M  p  1 9 
BCCOM220 
BECOM221 
BEC0M222 
BECOM?23 
BEC0M224 
BEC0M225 
BECOM226 
BECOM227 
BECOM228 
BECOM229 
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SUBROUTINE  BEMOD 


SUBROUTINE  BEMOD ( KK , J , S IGNT . EPNPH , ANM , ONHDEP )  BEMOD 

C  BEMOD 

COMMON  /S?/  ALF,CO*EEN,EENP1,EPN,KS,TAUEL,TAUI,TAUN,TAUO,VELS,VMU,ALCOM 
1  ZAM, ZAMUSV.ZEP,ZEPDSV.ZEPMAXC,ZEPMAXS, ZEPSAVE. ZTAUY.ZTAUYMX  alcom 

C  BEMOD 

DATA  ANM0.C8.ANMI2.A2/2.75E6.1.E12.1.E6.1.E4/  BEMOD 

C  bEMOD 

C  ««*  SUBROUTINE  BEMOD  CALCULATES  THE  MOBILE  DISLOCATION  DENSITY  BEMOD 

C  AND  ITS  DERIVATIVE  WITH  RESPECT  TO  PLASTIC  STRAIN  FOR  BEMOD 

C  BERYLLIUM  «**  BEMOD 

C  BEMOD 

IF  (KK  .GT.  0)  GO  TO  10  BEMOD 

C  BEMOD 

C  ***  LOADING  PHASE  ***  BEMOD 

C  BEMOD 

ANM=ANMO*CB*ABS (ZEPMAXC-EPNPH) *#2  BEMOD 

RETURN  BEMOD 

c  BEMOD 

C  «««  UNLOADING  OR  RELOADING  PHASE  BEMOD 

C  BEMOD 

10  EPB=ZEPMAXS-ABS (ZEPSAVE) *ABS (ZEPMAXC-EPNPH)  BEMOD 

ANMS=ANMO+C0«ABS (ZEPSAVE ) BEMOD 
ANM=ANMI2* ( ANMS-ANMI2) «EXP (-A2*EPB**2)  BEMOD 

RETURN  BEMOD 

C  BEMOD 

END  bEMOD 
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26 


SUBROUTINE  BFRACT 


SUBROUTINE  BFRACT ( LS , SXXEN, SYVEN , STTEN , TXYEN, EXX1 , EYY 1 , ETT 1 , EXY 1 , 

BFRACT2 

2 

1  P, NM , NT , VO , VOLD, DTO , E, EEST , EQSTCM, EQSTGM , ELMU, TSR, Y, YD, F , KS ,  JS, 

BFRACT2 

3 

2  M, NN, RHOS, DROT, ROT, FU2D, CL, CN) 

BFRACT2 

4 

c 

BFRACT2 

5 

c 

NEM  --  RELATIVE  VOLUME  OF  CRACKS 

BFRACT2 

6 

c 

NET  --  NUMBER  OF  CRACKS/UNIT  VOLUME 

BFRACT2 

7 

c 

T 1  --  CRACK  GROWTH  COEFFICIENT,  CM2/DYN/SEC 

BFRACT2 

8 

c 

T2  --  THRESHOLD  STRESS  FOR  GROWTH,  DYN/CM2 

BFRACT2 

9 

c 

T3  --  PARAMETER  OF  NUCLEAT I  ON  DISTRIBUTION,  CM 

BFRACT2 

10 

c 

T  4  --  NUCLEAT I  ON  RATE  COEFFICIENT 

BFRACT2 

1  1 

c 

T5  --  THRESHOLD  STRESS  FOR  NUCLEAT I  ON 

BFRACT2 

1  2 

c 

T6  --  DENOMINATOR  OF  EXPONENTIAL  STRESS  FUNCTION 

BFRACT2 

1  3 

c 

T7  - -  NOT  USED 

BFRACT2 

14 

c 

T8  --  THRESHOLD  STRESS  FOR  ENTERING  BFRACT 

BFRACT2 

1  5 

c 

T9  --  SWITCH  TO  INDICATE  WHETHER  S  OR  SDH  GOVERNS  NUCLEAT I  ON 

BFRACT2 

16 

c 

0  STRESS  GOVERNS 

BFRACT2 

1  7 

c 

1  DEVIATOR  STRESS  GOVERNS 

BFRACT2 

1  8 

c 

T10--  BETA,  RATIO  OF  NO.  OF  FRAGMENTS  TO  NO.  OF  CRACKS 

BFRACT2 

19 

c 

T11--  GAMMA,  RATIO  OF  FRAGMENT  RADIUS  TO  CRACK  RADIUS 

BFRACT2 

20 

c 

T 1 2 - -  VALUE  OF  CRACK  VOLUME  WHICH  DEFINES  THRESHOLD  OF  COALESENCE 

BFRACT2 

21 

c 

T 1 3 - -  TF,  WHERE  FRAGMENT  VOLUME  =  TF*RF**3 

BFRACT2 

22 

c 

CN  --  CRACK  DENSITY,  NUMBER/CM3 

BFRACT2 

23 

c 

CL  --  CUBE  OF  CRACK  RADI  US, CM3 

BFRACT2 

24 

c 

BFRACT2 

25 

DIMENSION  TSR ( 6, 30 ) , FN ( 7 ) , CL ( 1 ) , CN ( 1 ) , C0S2TH ( 4 ) , S I N2TH ( 4 ) , CL3(5) , 

BFRACT2 

26 

1  FNUC ( 5 ) , STH (5), INITC6), VCR ( 6 ) , VFR ( 6 ) , VCN ( 6 ) 

BFRACT2 

27 

REAL  NM, NT 

BFRACT2 

28 

DATA  ALF, SMF, NANG/1 . 0, 1 . 88, 5/ 

BFRACT2 

29 

IF  (LS  .GT.  0)  GO  TO  20 

BFRACT2 

30 

c 

x  X  X  XX  X  XX  XX  XX  XX  XX  X  XXX  X 

BFRACT2 

31 

c 

INITIALIZATION 

BFRACT2 

32 

c 

**********  *********** 

BFRACT2 

33 

c 

*  *  * 

INITIALIZE  GENERAL  ARRAYS  -  C0S2TH,  SIN2TH,  ROT,  CN,  CL,  FNUC 

BFRACT2 

34 

LS=  1 

BFRACT2 

35 

DO  5  1=1,6 

BFRACT2 

36 

I N I T (  I  ) =0 

BFRACT2 

37 

Is- 

ii 

n 

in 

D 

D 

BFRACT2 

38 

FN ( J ) =0 . 

BFRACT2 

39 

5 

CONTINUE 

BFRACT2 

40 

NANG1 =NANG- 1 

BFRACT2 

41 

FNUC ( 1 ) =0.7071 07/NANG1 

BFRACT2 

42 

FNUC (NANG) =0. 292893 

BFRACT2 

43 

C0S2TH ( 1 ) =1 . 0 

BFRACT2 

44 

S I N2TH ( 1 )=0. 

BFRACT2 

45 

DO  10  NG=2 , NANG1 

BFRACT2 

46 

FNUC ( NG ) =FNUC ( 1 ) 

BFRACT2 

47 

TW0TH=6 .2831 8 53* FLOAT ( NG- 1 ) /FLOAT ( NANG1 ) 

BFRACT2 

48 

C0S2TH ( NG ) =  COS ( TWOTH ) 

BFRACT2 

49 

1  0 

S I N2TH ( NG ) =S I N ( TWOTH ) 

BFRACT2 

50 

c 

XXX 

INITIALIZE  -TSR-  COEFFICIENTS  FOR  EACH  MATERIAL 

BFRACT2 

51 

20 

IF  ( INIT(M)  .EQ.  M)  GO  TO  25 

BFRACT  2 

52 

TSR(M, 3)=TSR(M, 3 )  ##3 

BFRACT2 

53 

VCR ( M ) =8 . *( 1 . /ELMU+1 . / ( EQSTCM+ELMU/3 . ) ) 

BFRACT2 

54 

VFR(M) =6. #TSR ( M, 1 3) #TSR(M, 1 0) *TSR(M, 1 1 ) **3 

BFRACT2 

55 

VCN(M) = -TSR ( M . 3) *TSR ( M . 4 ) 

BFRACT2 

56 

I N I T ( M ) =M 

BFRACT2 

57 

PRINT  1 025, M, ( TSR (M, I ), 1=1 , 1 4 ) , VCR ( M ) , VFR ( M ) , VCN ( M ) 

BFRACT2 

58 

1  025 

FORMAT ( *  INITIALIZE  BFRACT  FOR  M=*I2,*  TSR=*  1 P7E1 1 . 3/4X , 1 P7E1 1 . 3/ 

BFRACT2 

59 

1  *  VCR, VFR, VCN=*1P3E1 1 .3) 

BFRACT2 

60 

25 

CONTINUE 

BFRACT2 

61 

I F ( LS  . EQ.  3) GO  TO  500 

BFRACT2 

62 

C 

**********  *********** 

BFRACT2 

63 

C 

COMPUTATIONS 

BFRACT2 

64 

C 

**********  *********** 

BFRACT2 

65 

IF  (NM  . LT.  0. )  GO  TO  410 

BFRACT2 

66 

IF  (NT  . EQ.  0. )  FU2D= 1 . 

BFRACT2 

67 

FU0=FU2D 

BFRACT2 

68 

VSO=VOLD# ( 1 . -NM) /FUO/RHOS 

BFRACT2 

69 

VVO= VOLD/RHOS- VSO 

BFRACT2 

70 

DV=DVO= ( VO -VOLD ) /RHOS 

BFRACT2 

71 

D0LD=RHOS/VOLD 

BFRACT2 

72 

PS0  =  P/ ( VS0#FUO*DOLD ) 

BFRACT2 

73 

R=ROT  $  PO=P 

BFRACT2 

74 

C 

XXX 

SET  VALUES  FOR  MULTIPLE  LOOPS  IN  CASE  OF  LARGE  STRAIN 

BFRACT2 

75 

C 

MULTIPLE  LOOPS  IF  STRAIN  CORRESPONDS  TO  A  STRESS  GREATER  THAN 

BFRACT2 

76 
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SUBROUTINE  BFRACT  (Continued) 


C  0 . 33#TSR (M,  5 ) 

SDH= AM I N1  ( SXXEN, SYYEN  , STTEN ) 

NLOOP=MAX1  ( 1  . , -4.  #DV#EQSTCM/VSO/TSR(M,  5) +0 . 5, DT0#20 . *TSR(M, 1  ) * ( PSO 
1  +SDH-TSR (Mj 2) )+0. 5) 

NLOOP  =  M I  NO ( NLOOP, 10) 

PS=  ( EQSTCM/RHOS+EQSTGM#EEST ) / ( VSO+DV ) -EQSTCM 
IFCPSO  .QT.  0.  .AND.  PS  . QT .  0.)  NLOOP- 1 
DPJ=0. 5#  CABS ( TSR (M, 5) )+ABS(PSO) ) 

NTRY=0 

100  DELV=DV/NLOOP 

IFCABSCDVO)  .LT.  1.E-9)  DV0-1.E-9 

EXX=EXX1 /NLOOP#DV/DVO 

EYY=EYY 1 /NLOOP# DV/DVO 

ETT  =  ETT1 /NLOOP#DV/DVO 

EXY=EXY1 /NLOOP#DV/DVO 

VH= 1 . /DOLD  $  YT=Y 

DE= ( EEST -E ) /NLOOP 

El  =E 

TEMPI =1 . /RHOS+EQSTGM#E/EQSTCM 
DR=DELV/DVO#DROT 
DT  =DELV/DVO#DTO 
A1 =3. #TSR (M ,  1  )#DT 

###  BEGIN  -DO-  LOOP  FOR  EACH  STEP  IN  STRAIN 
DO  380  NL= 1 ,  NLOOP 
VH= VH+DELV 
DH= 1 . /V H 
El =E 1 +DE 
TEMP0=TEMP1 

TEMPI =1 . /RH0S+EQSTGM*E1 /EQSTCM 
SDH  =  AMIN1  ( SXXEN , SYYEN  , STTEN ) 

V0P0=0. 

DO  120  NA= 1 j NANG 
20  VOPO= VOPO+CN ( NA )  #CL  ( NA ) 

TAUO=VFR (M ) * VOPO 
VOPO  =  -  VCR  CM) *VOPO 

*****  *#### 

*****  ESTIMATE  SOLID  PRESSURE  TO  BEGIN  ITERATIONS  ***** 

*****  STRAIN  BASIS  FOR  PRESSURE  ESTIMATE  ***** 

*****  ***** 

PS =PG=PN= EQSTCM# ( TEMPI / ( VSO+DELV ) - 1  .  ) 

IF  (P  .LT.  0. )  GO  TO  130 

C  CRACK  OPENING  BASIS  FOR  PRESSURE  ESTIMATE 

PG  =  PSO+ ( DELV- TEMPI  * ( 1  . “PSO/ EQSTCM) +VSO) / (VOPO- 1  . /EQSTCM# TEMPI  ) 

IF  (PG  .GT.  0.)  PGaPSO- ( DELV -TEMPI # ( 1 . -PSO/ EQSTCM) +VSO ) / ( TEMPI / 

1  EQSTCM) 

GO  TO  150 

C  NUCLEAT I  ON  BASIS  FOR  PRESSURE  ESTIMATE 

130  IF  (DELV  .GT.  0.)  PN= -PSO+2 . #TSR C M, 5 ) +2 . * TSR ( M , 6 ) # ALOG ( ABS ( DELV/ 

1  VCR ( M ) /VCN  CM ) /DT /PSO ) ) 

C  GROWTH,  EXPANSION,  AND  STRAIN  BASIS  FOR  PRESSURE  ESTIMATE 

XP  =  EXP  C  A 1 #AM I N1  (0. , PSO+SDH-TSR ( M, 2) ) ) 

PGsPSO+  (  DELV  -  WO  #XP+VVO-VSO+TEMPO/ TEMPI  *VSO )  /  ( VVO#XP*  (  1  .  /  CPSO+SDH) 
1  +A1/2. ) -VS0#VS0/EQSTCM/TEMP1 ) 

150  PJ=AMAX1 ( PS, PG, PN ) 

DVS=TEMP 1/(1 . +PJ/EQSTCM) -VSO 
COSR=COS ( 2 . #R ) 

S I NR=S I N ( 2 . *R) 

C  ***  COMPUTE  STRESSES  AT  TIME(N-I)  FOR  EACH  ANGULAR  GROUP 
STH(NANG) =STTEN+PSO 
DO  170  NA= 1 , NANG1 

1 70  STH(NA) = (SXXEN+SYYEN)/2. +PSO+ (SXXEN -SYYEN )/2. * ( C0S2TH ( NA ) *COSR- 
1  SI N2TH( NA) #SI NR) +TXYEN# (SI N2TH( NA) *C0SR+C0S2TH ( NA ) #SI NR ) 
SINR=SIN(2. *(R+DR) ) 

COS R= COS ( 2 . # ( R+DR ) ) 

NC=0 
ETAU=0 . 

IF  ( TAUO 
CONTINUE 
***** 

CONTINUE 
NC=NC+ 1 


1220 
C###  # 

c 

c#  ##  # 

200 


. GT .  0. )  ETAU=EXP(A1 *AMI N1 (0. , PSO+SDH-TSR ( M, 2 ) ) )*TAUO 


BEGIN  ITERATION  LOOP 


******** 
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77 

78 

79 

80 
81 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 
1  00 
101 
1  02 
1  03 
104 
1  05 
1  06 
1  07 
1  08 
1  09 
1  1  0 
1  1  1 
1  1  2 
1  1  3 
1  14 
1  15 
1  16 
1  17 
1  1  8 
119 
1  20 
121 
122 
123 
1  24 

125 

126 
1  27 
128 

129 

130 
1  31 
1  32 

133 

134 

135 

136 
1  37 
1  38 
1  39 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 
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SUBROUTINE  BFRACT  (Continued) 


c  *  *  * 

COMPUTE  PRESSURE 

BFRACT2 

151 

PA=EQSTCM* ( TEMPI / ( VS0+DVS) - 1 . ) 

BFRACT2 

152 

TAU=ETAU*EXP(AMIN1 (2. , A1/2. *(PA-PS0) ) ) 

BFRACT2 

153 

FU 1 = AMAX1 C0.jAMIN1C1.jC1. -TAU)/( 1 . -TSR(M, 12) ) ) ) 

BFRACT2 

154 

VV  =  VH-FU 1  * (VSO+DVS) 

BFRACT2 

155 

c  *  *  * 

COMPUTE  DEVIATOR  STRESS 

BFRACT2 

156 

RED  =  AMAX1  (0.  ,1.-4.  *W*DH) 

BFRACT2 

1  57 

RED  1  =  AMAX1  (  1  .  -SMF*VV*DH,  0.  ) 

BFRACT2 

1  58 

WS1  =  -  .  66667*  (  DOLD-DH  )  /  (  DOLD-hDH  ) 

BFRACT2 

159 

BETA=2. *TXYEN*DR0T/NL00P*DV/DVO 

BFRACT2 

1  60 

ELMUF  =  RED 1 *2. *ELMU 

BFRACT2 

1  61 

TXYE  =  TXYEN+ELMUF*EXY+ ( SYYEN-SXXEN) *DR0T  *DELV/DVO 

1 0/8/79 

59 

SXXE=SXXEN+ELMUF* ( EXX-WS1 ) +BETA 

BFRACT2 

1  63 

SYYE=SYYEN+ELMUF* ( EYY-WS1 ) -BETA 

BFRACT2 

1  64 

STTE  =  STTEN+ELMUF  * ( ETT-WS1 ) 

BFRACT2 

1  65 

WS4  =  SXXE*  *2+SYYE*  *  2+STTE*  *2+2 , *TXYE**2 

BFRACT2 

166 

YE  =  YT  *F*RED 

BFRACT2 

1  67 

IF  ( WS4  .LE.  YE* *2/ 1  . 5 )  GO  TO  230 

BFRACT2 

1  68 

WS3=YE/SQRT( 1 . 5*WS4 ) 

BFRACT2 

1  69 

SXXE=SXXE*WS3 

BFRACT2 

1  70 

SYYE=SYYE*WS3 

BFRACT2 

171 

TXYE=TXYE*WS3 

BFRACT2 

1  72 

STTE=STTE* WS3 

BFRACT2 

1  73 

230 

CONTINUE 

BFRACT2 

174 

c  *  *  * 

COMPUTATION  OF  CRACK  VOLUME  FROM  ELASTIC  OPENING,  GROWTH, 

BFRACT2 

1  75 

c 

NUCLEAT I  ON  AND  FRAGMENTATION 

BFRACT2 

1  76 

VVA  =  0 . 

BFRACT2 

177 

TAU=0, 

BFRACT2 

1  78 

DO  250  NA= 1 , NANG 

BFRACT2 

1  79 

IF  (NA  . LT .  NANG)  GO  TO  237 

BFRACT2 

1  80 

STHW  =  STTE+PA 

BFRACT2 

1  81 

GO  TO  240 

BFRACT2 

1  82 

237 

STHW=PA+ ( SXXE+SYYE ) /2 . + ( SXXE-SYYE ) /2 . * ( C0S2TH ( NA ) *COSR-S I N2TH ( NA ) * 

BFRACT2 

1  83 

1  SI  NR) +TXYE* (SI N2TH(NA) *C0SR+C0S2TH ( NA ) *SI NR) 

BFRACT2 

1  84 

24  0 

SAVG= ( STH ( NA ) +STHW ) /2 . 

BFRACT2 

1  85 

DTC  =  CN ( NA ) *  DH/DOLD*  CL ( NA ) 

BFRACT2 

1  86 

IF  ( SAVG  .LT.  TSR ( M , 2 ) )  DTC»DTC*EXP ( A 1  * ( SAVG -TSR ( M, 2 ) ) ) 

BFRACT2 

187 

SCN=SAVG~TSR ( M, 9 ) * ( PSO+PA ) /2 . -TSR CM, 5) 

BFRACT2 

1  88 

DTN=0 . 

BFRACT2 

1  89 

IF  ( SCN  .LT.  0.)  DTN  =  TSR ( M , 4 ) *EXP ( SCN/TSR ( M , 6 ) ) *DT*FNUC ( NA ) 

BFRACT2 

1  90 

1  *TSR ( M , 3 ) 

BFRACT2 

191 

IF  (STHW  .LT.  0.)  VVA=VVA-VCR ( M) *STHW* ( DTC+DTN ) 

BFRACT2 

192 

250 

TAU=TAU+DTC+DTN 

BFRACT2 

193 

VVA=VVA/DH 

BFRACT2 

194 

TAU=VFR(M)*TAU 

BFRACT2 

1  95 

FU1 = AMAX 1 (0. , AMIN1 ( 1 . , ( 1 . -TAU)/C 1 . -TSR CM, 12) ) ) ) 

BFRACT2 

1  96 

C  *  *  * 

COMPUTE  CHANGES  IN  V  AND  IN  V  SUB  S 

BFRACT2 

1  97 

SDH= AM I N 1 (SXXE, SYYE, STTE ) 

BFRACT2 

1  98 

DVSA=  DVS 

BFRACT2 

1  99 

DELVA=DVS+VVA-VVO 

BFRACT2 

200 

PJ  =  PA 

BFRACT2 

201 

c 

BFRACT2 

206 

c  *  *  * 

TEST  FOR  COMPLETION  OF  ITERATIONS 

BFRACT2 

207 

IF  ( ABS ( DELVA-DELV ) /VSO  .LT.  2.E-5)  GO  TO  300 

BFRACT2 

208 

IF  (NC  .GE.  30)  GO  TO  450 

BFRACT2 

209 

c 

DELVA  IS  RECENT  VALUE,  DELVB  IS  LARGER  STORED  VALUE,  AND 

BFRACT2 

210 

c 

DELVC  IS  SMALLER  STORED  VALUE. 

BFRACT2 

21  1 

IF  (NC  . EQ.  1 )  GO  TO  270 

BFRACT2 

212 

I F ( NC . EQ , 2 ) GO  TO  260 

BFRACT2 

213 

IF  (DELVC  .GT.  DELV)  GO  TO  265 

BFRACT2 

214 

IF  (DELVB  .LT.  DELV)  GO  TO  260 

BFRACT2 

215 

IF  (DELVA  .GT.  DELV)  GO  TO  265 

BFRACT2 

216 

c 

INTERPOLATION  TO  FIND  DVS 

BFRACT2 

217 

260 

DVS=  DVSA+ ( DVSB-DVSA) / ( DELVB -DELVA) * ( DELV-DELVA) 

BFRACT2 

21  8 

IF  ( MOD ( NC+2 , 3 )  . EQ .  0)  DVS= 0 . 5* ( DVSA+DVSB ) 

BFRACT2 

219 

GO  TO  280 

BFRACT2 

220 

265 

DVS=DVSA+ ( DVSC-DVSA) / ( DELVC- DELVA ) * ( DELV-DELVA) 

BFRACT2 

221 

IF  ( MOD ( NC+2, 3 )  . EQ .  0)  DVS=0 . 5* ( DVSA+DVSC ) 

BFRACT2 

222 

GO  TO  280 

BFRACT2 

223 

270 

PJ=PA+( DELV-DELVA) /( VVA* ( 1 ./(PA+SDH/2. )+A1/2. ) -TEMP 1 / ( EQSTCM+PA ) ) 

BFRACT2 

224 

IF  (PJ  .LT.  0.  .OR.  PA  .GE.  0.)  GO  TO  279 

BFRACT2 

225 

197 


SUBROUTINE  BFRACT  (Continued) 

P J=PA+EQSTCM*  (  VVA-DELV)  /VSO 

BFRACT2 

226 

IF  (PJ  .LT.  0.)  PJ-AMAX1 (PJ,PA)/2. 

BFRACT2 

227 

279 

P J  =  PA+S I GN ( AM  I N 1 ( ABS ( PJ “PA ) , DP J ) , DELVA-DELV ) 

BFRACT2 

228 

DVS=TEMP 1/(1 . +PJ/EQSTCM) -VSO 

BFRACT2 

229 

280 

IF  (NO  .GT.  2)  GO  TO  285 

BFRACT2 

230 

IFCNC.EQ. 1 ) GO  TO  290 

BFRACT2 

231 

IF  (DELVA  .LT.  DELVB )  293,289 

BFRACT2 

232 

285 

IF  (DELVA  .GT.  DELVB  .OR.  DELVA  . LT .  DELVC )  GO  TO  287 

BFRACT2 

233 

IF  (DELVA  .LT.  DELV)  293,290 

BFRACT2 

234 

287 

IF  (DELVB  .LT.  DELV  .AND.  DELVA  . GT .  DELVB)  GO  TO  289 

BFRACT2 

235 

IF  (DELVC  .GT.  DELV  .AND.  DELVA  . GT .  DELVC)  292,200 

BFRACT2 

236 

289 

DELVC=DELVB 

BFRACT2 

237 

DVSC=DVSB 

BFRACT2 

238 

290 

DELVB=DELVA 

BFRACT2 

239 

DVSB=DVSA 

BFRACT2 

240 

GO  TO  200 

BFRACT2 

241 

292 

DELVB=DELVC 

BFRACT2 

242 

DVSB=DVSC 

BFRACT2 

243 

293 

DELVC-DELVA 

BFRACT2 

244 

DVSC=DVSA 

BFRACT2 

245 

GO  TO  200 

BFRACT2 

246 

C 

BFRACT2 

247 

C 

ENDING  ROUTINE 

BFRACT2 

248 

300 

CONTINUE 

BFRACT2 

249 

NT  =  0 . 

BFRACT2 

250 

R=R+DR 

BFRACT2 

251 

DO  320  NA= 1 , NANG 

BFRACT2 

252 

IF  (NA  .LT.  NANG)  GO  TO  307 

BFRACT2 

253 

STHW=STTE+P J  $  GO  TO  310 

BFRACT2 

254 

307 

STHW=P J+ ( SXXE+SYYE ) /2 . + ( SXXE-SYYE ) /2 . * ( C0S2TH ( NA) *COSR-S I N2TH ( NA ) * 

BFRACT2 

255 

1  S I  NR ) +TXYE* ( S I N2TH ( NA ) *C0SR+C0S2TH ( NA ) *S I  NR ) 

BFRACT2 

256 

310 

SAVG= ( STH ( NA ) +STHW ) /2 . 

BFRACT2 

257 

STH ( NA ) =STHW 

BFRACT2 

258 

SCN=SAVG-TSR(M, 9) *(PSO+PJ) /2. -TSR (M, 5) 

BFRACT2 

259 

DN  =  0 . 

BFRACT2 

260 

IF  ( SCN  .LT.  0.)  DN=TSR(M,4)*EXP(SCN/TSR(M,6) ) *DT*FNUC ( NA ) 

BFRACT2 

261 

CNO=CN( NA ) 

BFRACT2 

262 

CN(NA) -CN(NA) *DH/DOLD+DN 

BFRACT2 

263 

IF  (CN(NA)  .EQ.  0.)  GO  TO  320 

BFRACT2 

264 

CL ( NA ) = ( CNO*CL ( NA ) *EXP ( A1 *AMI N1 (SAVG-TSR(M, 2) , 0. ) )+ 

BFRACT2 

265 

1  DN*TSR(M, 3) ) /CN(NA) 

BFRACT2 

266 

NT  =  NT+CN( NA) 

BFRACT2 

267 

320 

CONTINUE 

BFRACT2 

268 

350 

NM  = ( VVA+ (  1  . -FU1  ) * ( VSO  +  DVS ) )*DH 

BFRACT2 

269 

FU2D=FU1 

BFRACT2 

270 

PSO=PJ 

BFRACT2 

271 

IF  ( FU1  .LT.  0.01)  GO  TO  400 

BFRACT2 

272 

P J=PJ#FU1 * ( VSO+DVS ) *DH 

BFRACT2 

273 

SXXENaSXXE 

BFRACT2 

274 

SYYEN=SYYE 

BFRACT2 

275 

STTEN=STTE 

BFRACT2 

276 

TXYEN-TXYE 

BFRACT2 

277 

P  =  PJ 

BFRACT2 

278 

Y  ■  YT 

BFRACT2 

279 

C 

********** 

BFRACT2 

280 

c 

END  OF  SUBCYCLING  LOOP 

BFRACT2 

281 

c 

********** 

BFRACT2 

282 

VVO=VVA 

BFRACT2 

283 

VSO= VSO+DVS 

BFRACT2 

284 

FU0=FU1 

BFRACT2 

285 

380 

DOLD=DH 

BFRACT2 

286 

ROT  =  R 

BFRACT2 

287 

I F ( LS  .EQ.  2) GO  TO  500 

BFRACT2 

288 

RETURN 

BFRACT2 

289 

c 

BFRACT2 

290 

C 

END  WITH  SEPARATION 

BFRACT2 

291 

400 

CONTINUE 

BFRACT2 

292 

SXXEN*0. 

BFRACT2 

293 

SYYEN-O. 

BFRACT2 

294 

STTEN-O. 

BFRACT2 

295 

TXYEN-O. 

BFRACT2 

296 

P*0  . 

BFRACT2 

297 

Y  =YT 

BFRACT2 

298 

NM= -ABS ( NM ) 

BFRACT2 

299 

RETURN 

BFRACT2 

300 
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SUBROUTINE  BFRACT  (Continued) 


410 

CONTINUE 

BFRACT2 

301 

SXXEN=0 . 

BFRACT2 

302 

SYYEN=0 . 

BFRACT2 

303 

STTEN=0 . 

BFRACT2 

304 

TXYEN=0. 

BFRACT2 

305 

EMU= 1 ./VO-1 . 

BFRACT2 

306 

P=(EQSTCM*EMU)*( 1 . - . 5*EQSTGM*EMU ) +EQSTGM*E* RHOS/VO 

BFRACT2 

307 

I F ( P  . LT . 0 . )  P=0. 

BFRACT2 

306 

I F(LS. EQ. 2) GO  TO  500 

BFRACT2 

309 

RETURN 

BFRACT2 

310 

C 

BFRACT2 

31  1 

c  #  #  # 

PROVISION  FOR  ABORT  IN  CASE  OF  ITERATION  FAILURE 

BFRACT2 

312 

450 

NTRY=NTRY+1 

BFRACT2 

313 

IF  ( NTRY  .GE.  5)  GO  TO  460 

BFRACT2 

314 

DV  =  \/0/RH0S -  1  . /DOLD 

BFRACT2 

315 

NLOI  D=NLOOP 

BFRACT2 

316 

NLO(iP  =  MAX1  (3.  , -4. *2. **NTRY*DV*EQSTCM/VSO/TSR(M,  5) +0 . 5, 2 . *NLOOP) 

BFRACT2 

317 

I F ( VSR ( M ,  6  ) . GT. 0. )NLOOP=MIN1 ( AMAX1 (3. , 4 . *2* # NTRY * DV* EQSTCM/VSO 

BFRACT2 

316 

1  /3 . E9+0 .5,2. *NLOLD ) ,10. *  NLOLD ) 

BFRACT2 

31  9 

GO  TO  100 

BFRACT2 

320 

460 

PRINT  1600, NN, KS , JS , SDH, P, DV, DELVA, DELVB , DELV, DVO, VO 

BFRACT2 

321 

IF  (NTRY  .EQ.  5)  STOP  22 

BFRACT2 

322 

NT  =  0 . 

BFRACT2 

323 

R  =  R+DR 

BFRACT2 

324 

TAU=0. 

BFRACT2 

325 

DO  620  NA= 1 , NANG 

BFRACT2 

326 

IF  (NA  . LT .  NANG)  GO  TO  607 

BFRACT2 

327 

STHW=STTE+P J  $  GO  TO  610 

BFRACT2 

328 

607 

STHW=PJ+ ( SXXE+SYYE ) /2 . + ( SXXE-SYYE ) /2 . * ( C0S2TH ( NA) * COSR-S I N2TH ( NA ) * 

BFRACT2 

329 

1  S I  NR ) +TXYE* (SI N2THCNA) * C0SR+C0S2TH ( NA ) *SINR) 

BFRACT2 

330 

61  0 

SAVG= ( STH ( NA ) +STHW ) /2 . 

BFRACT2 

331 

SCN=SAVG-TSR(M, 9)* (PS0+PJ)/2. -TSR(M, 5) 

BFRACT2 

332 

DN  =  0 . 

BFRACT2 

333 

IF  ( SON  .LT.  0.)  DN  =  TSR(M,4) *EXP ( SCN/TSR ( M, 6) ) *  DT*  FNUC ( NA ) 

BFRACT2 

334 

CNO  =  CN ( NA ) 

BFRACT2 

335 

CN ( NA ) =CN ( NA ) *  DH/DOLD+DN 

BFRACT2 

336 

I F ( CN ( NA )  .EQ.  0.)  GO  TO  620 

BFRACT2 

337 

CL ( NA )  =  ( CNO*  CL ( NA ) #  EXP ( A1 * AM  I N 1 ( SAVG-TSR (M, 2 ) , 0 .  ) )  + 

BFRACT2 

336 

1  DN*TSR(M, 3) )/CN(NA) 

BFRACT2 

339 

NT=NT+CN ( NA) 

BFRACT2 

340 

620 

TAU  =  TAU  +  CN ( NA ) *  CL ( NA ) 

BFRACT2 

341 

TAU  =  VFR ( M ) *  TAU 

BFRACT2 

342 

FU 1 = AMAX1 (0. , AMIN1 ( 1 . , ( 1 . -TAU)/( 1 . -TSR (M, 12) ) ) ) 

BFRACT2 

343 

FU2D=FU1 

BFRACT2 

344 

NM= ( VVA+ ( 1 . -FU 1 )*(VSO+DVS) )*DH 

BFRACT2 

345 

IF  ( FU 1  .LT.  0.01)  GO  TO  400 

BFRACT2 

346 

PJ=PJ*FU1 * ( VSO+DVS ) *  DH 

BFRACT2 

347 

EEST  =  EEST  + ( PO-PJ ) *DELV 

BFRACT2 

348 

SXXEN=SXXE 

BFRACT2 

349 

STTEN=STTE 

BFRACT2 

350 

TXYEN=TXYE 

BFRACT2 

351 

P  =  PJ 

BFRACT2 

352 

Y  =  YT 

BFRACT2 

353 

VVO= VVA 

BFRACT2 

354 

VSO= VSO+DVS 

BFRACT2 

355 

DOLD=DH 

BFRACT2 

356 

ROT  =  R 

BFRACT2 

357 

I F ( LS  .EQ.  2) GO  TO  500 

BFRACT2 

358 

RETURN 

BFRACT2 

359 

C 

BFRACT2 

360 

C 

FINAL  PRINTOUT 

BFRACT2 

361 

C 

BFRACT2 

362 

500 

I ZERO  = 1 

BFRACT2 

363 

IF  (NT  .EQ.  0. )  GO  TO  520 

BFRACT2 

364 

I ZER0=2 

BFRACT2 

365 

CNSUM=0. 

BFRACT2 

366 

CR I T2=0 . 

BFRACT2 

367 

CR I T3=0 . 

BFRACT2 

368 

DO  510  NA= 1 , NANG 

BFRACT2 

369 

CL3 ( NA ) =CL ( NA ) *  * ( . 3333333333) 

BFRACT2 

370 

CR I T2  =  CR I T2+CN ( NA ) *  CL 3 ( NA ) *  *2 

BFRACT2 

371 

CNSUM=CNSUM+CN ( NA ) 

BFRACT2 

372 

510 

CR I T3=CR I T3+CN( NA) #CL ( NA) 

BFRACT2 

373 

I F ( CNSUM  .EQ.  0.)  GO  TO  520 

BFRACT2 

374 

CR I T2  =  3 . 1416*  CR I T2 

BFRACT2 

375 

199 


SUBROUTINE  BFRACT  (Concluded) 


RAD= ( OR  1 T3/CNSUM ) *  * ( 1  ./3.  ) 

BFRACT2 

376 

FRAGRAD*0 . 

BFRACT2 

377 

FRAGNUM=0. 

BFRACT2 

378 

IFCFU2D  , EQ .  1 . )GO  TO  515 

BFRACT2 

379 

FRAGRAD=RAD*TSR(M, 1 1 ) 

BFRACT2 

380 

FRAGNUM=CNSUM#TSR(M, 10)*M . -FU2D) 

BFRACT2 

381 

515 

CONTINUE 

BFRACT2 

382 

PRINT  1510, (CL3( I  )  ,  I =1 , 5) , RAD, CRI T2, ROT, FU2D,KS, JS, ( CN( I ) , 1=1,5), 

BFRACT2 

383 

1  CNSUM, FRAGRAD, FRAGNUM 

BFRACT2 

384 

520 

CONTINUE 

BFRACT2 

385 

RETURN 

BFRACT2 

386 

1510 

FORMAT ( 13H0CELL  CL  =  1 P4E1 0 . 3, 2X, El  0 . 3, 1 1 H  CL-AVG  =  E10.3, 

BFRACT2 

387 

1  12H  PI *N*R**2=0PF6, 0,6H  ROT=F6.0,5H  FU=F6 . 4/2 I 3 , 7H  CN  = 

BFRACT2 

388 

2  1 P4E1 0 . 3, 2X , E 1 0 . 3 , 1  OH  CN-TOT  =E10.3,16H  FRAGMENT  RAD.=E10.3, 

BFRACT2 

389 

3  6H  NO . =E 1 0 . 3 ) 

BFRACT2 

390 

1600 

FORMAT ( 32H  ITERATION  FAILURE  IN  BFRACT,  N=I5,4H,  K=I3,4H,  J=I3, 

BFRACT2 

391 

1  1P5E12.3/5X, 1P3E12.3) 

BFRACT2 

392 

END 

BFRACT2 

393 

200 


SUBROUTINE  CAP1 


SUBROUTINE  CAP1 (LS, IN,M,N, I H, DH, DORG, E, EX, EY, EZ, EXY , SX, SY ,  CAP! 

1  SZ, SXY , ZEVP ,  K ,  J  , TEVP )  CAP1 

C  CAP! 

C  CAP1  -  WRITTEN  BY  L.  SEAMAN  -  INSERTED  INTO  THE  COPS  CODE  10-78  CAP1 

C  CAP  1 

C  ********  ***********  CAP 1 

C  DEFINITION  OF  INDICATOR  -IH-  5  -  ELASTIC  CAP1 

C  6  -  MOHR-COULOMB  SURFACE  7  -  CAP  SURFACE  CAP1 

C  8  -  CAP  AND  MOHR-COULOMB  9  -  CONSOLIDATED  CAP1 

C  10  -  SEPARATION  CAP1 

C  CAP  1 

INTEGER  DBUG 1 , DBUQ2  CAP1 

REAL  MUP , MUP2  CAP1 

DIMENSION  INI T(4) ,  AMC1 (4) , AMC2(4) , AMC3(4 ) , AMC4 (4 )  , AMC5(4) ,  CAP1 

1  AMC6 ( 4 ) , AK ( 4 )  , AK2 (4) , MUP ( 4 ) , MUP2 (4 ) , NREG ( 4 )  , DAMGC4) ,  CAP1 

2  SCRIT(4) , W2(4) , AKS0L(4)  CAP1 

DIMENSION  PA (5)JAJ(5)JDL(2)  CAP1 

COMMON  /EQS/  EQSTC ( 6 )  , EQSTD ( 6 ) , EQSTE ( 6 ) , EQSTG ( 6 )  , EQSTH ( 6 )  , EQSTN ( 6 )  CAP1 

1  , EQSTS ( 6 ) , RHO( 6 ) , RHOS ( 6 ) , YC(6) , YADC6) , MU (6) , ESC (6, 20) .CLIN, CQSQ,  CAP1 

2  TR  I  Q , AMAT (6,4) , SP ( 6 ) , G2 ( 6 ) , PM  I N ( 6 )  CAP1 

COMMON  /POR/  PORA (6,5), PORB (6, 5) , PORC ( 6 , 5) , EVP (6,5)  CAP1 

DATA  I N I T /4#0/  CAP1 

GH(X)=MUP(M)+MUP2(M)*AMIN1 (AMC1 (M),X)  CAP 1 

GG(X, Y) =MUP(M)+MUP2(M) *AMIN1 (AMC1 (M) , 0. 5* (X+Y) )  CAP1 

BKK ( X , Y ) =  AM I N 1 ( AKSOL(M) , AK(M) +AK2CM) *AM I N1 (0. , . 5* (X+Y) ) )  CAPl 

BKH ( X ) =AM I N1 ( AKSOL ( M ) , AK ( M ) +AK2  CM) * AM I N 1 (0. ,X) )  CAPl 

C  CAPl 

IF  (LS)  30,30,50  CAPl 

C  ********  ***********  CAPl 

C  READ  AND  INITIALIZE  MATERIAL  ARRAYS.  CAPl 

C  ********  ***********  CAPl 

30  IFUNIT(M)  .EQ.  M)  GO  TO  50  CAPl 

I N I T ( M ) =M  CAPl 

READ  (IN,  1 020 ) A 1 , A2 , AK( M ) , A3, A4 , AK2 ( M ) , A5, A6,MUP(M) , A7, A8,  MUP2(M)  CAPl 
PRINT  1040,  A1 , A2, AK ( M ) , A3, A4 , AK2(M) , A5, A6, MUP (M) , A7, A8 , MUP2 ( M )  CAPl 

PRINT  1021 , IN  CAPl 

READ  ( IN, 1 022 )A1 , A2, AMC1 (M ) , AMC2 ( M ) , AMC3(M) , AJ10, EN  CAPl 

PRINT  1042,  A 1 , A2, AM Cl (M ) , AMC2 ( M ) , AMC3 ( M ) , A J 1 0 , EN  CAPl 

AMC4 ( M  )  =  -  ( AMC1 ( M ) +AMC2 (M ) *EXP ( A J 1 0/AMC3 ( M ) ) )*EXP(-EN)  CAPl 

AMC5(M) -AJ10/EN  CAPl 

AMC6 ( M ) = A J 1 0  CAPl 

PRINT  1021 , IN  CAPl 

READ  ( IN,  1 020 )A1 , A2, SCR  I T ( M ) , A3, A4 , DAMG (M ) , A5 , A6, AKSOL (M )  CAPl 

IF  ( AKSOL (M )  .LT.  AK(M) )  AKSOL ( M ) =2 . #AK (M )  CAPl 

PRINT  1 040,  A 1 , A2, SCRIT(M) , A3, A4, DAMG(M ), A5, A6, AKSOL (M )  CAPl 

PRINT  1021 , IN  CAPl 

READ  (IN, 1022)A1 ,A2, (EVP(M, I ), 1=1,5)  CAPl 

PRINT  1042,  A 1 , A2, ( EVP (M, I ), 1=1,5)  CAPl 

PRINT  1021 , IN  CAPl 

READ  ( I N, 1 024) A1 , A2, NREG(M) , A3, A4, NPRCAP , A5, A6, PI , A7, A8, W2 ( M )  CAPl 

PRINT  1044,  A1 ,A2, NREG(M) , A3, A4, NPRCAP, A5, A6, PI ,A7, A8,W2(M)  CAPl 

PRINT  1021 , IN  CAPl 

C  COMPUTATION  OF  PARAMETERS  ON  HYDROSTAT  CAPl 

PORA ( M, 1 ) =P1  CAPl 

PORB ( M, 1 ) =0 .  CAPl 

PORC (M , 1 ) =0 ,  CAPl 

NP  =  M I  NO ( NREG ( M ) ,4)  CAPl 

DO  15  NQ= 1 , NP  CAPl 

READ  ( IN, 1020)A1 , A2,P2, A3,A4, DELP  CAPl 

PRINT  1040,  A1 , A2, P2, A3, A4, DELP  CAP! 

PRINT  1021, IN  CAPl 

DE=  EVP (M , NQ  +  1 ) -EVP (M, NQ)  CAP! 

DP=4 . #DELP/DE  CAPl 

PORA ( M, NQ+1 ) =P1 -EVP ( M , NQ)/DE#(P2-P1 +DP#EVP (M, NQ+1 ) )  CAPl 

PORB (M, NQ+1 ) = ( P2 -PI +DP# ( EVP ( M , NQ ) +EVP (M, NQ+1 ) ) )/DE  CAPl 

PORC(M, NQ+1 )= -DP/DE  CAP! 

15  P 1 =P2  CAPl 

EVP ( M , 5 ) =  EVP ( M , NP+1 )  CAPl 

C  SET  ACCURACY  CRITERIA  CAPl 

NMAX=30  CAPl 

FOR 1 =60 .  CAPl 

FCR2  =  300 .  CAPl 

DFCR1 -  1  . E5  CAPl 

C  SET  LPATH=0  FOR  CONSTANT  VOLUME  ON  M-C,  =1  FOR  NORMALITY  CAPl 

LPATH= 1  CAPl 


2 

3 

4 

5 

6 

7 

8 
9 

10 
1  1 
12 

13 

14 

15 
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1  7 
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1  9 
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48 
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SUBROUTINE  CAP1  (Continued) 


PRINT  1 004 ,  FCR 1 , FCR2 , DFCR1 , NMAX, LPATH 

CAP1 

77 

1004 

FORMAT  (*  ACCURACY  AND  SUBCYCLING  CRITERIA  FCR 1 , FCR2  =*1P2E10.3, 

CAP  1 

78 

1  *  DFCR 1 , NMAX=  *  E10.3, 14,/*  MOHR-COULOMB  PATH,  LPATH=*I2, 

CAP  1 

79 

2  *  -  0  -  FOR  CONSTANT  VOLUME,  -  1  -  FOR  NORMALITY*) 

CAP  1 

80 

C 

CAP  1 

81 

DBUG1 ho 

CAP  1 

82 

DBUG2= 1 

CAP1 

83 

I F ( DBUG2 . EQ . 0 )  GO  TO  41 

CAP  1 

84 

DO  31  1=1,5 

CAP1 

85 

PA( I )=( 1+1 ) *PORA ( M, 1 )/2. 

CAP1 

86 

31 

A J ( I ) =0 . 

CAP1 

87 

PRINT  3000, (PA( I ) , I =1 , 5) 

CAP1 

88 

3000 

FORMAT  ( *1 MOHR-COULOMB  AND  CAP  COORD  I  NATES* /20X, *J 1 *, 9X, *M-C* , 

CAP  1 

89 

1  9X,*J2  ON  CAPS  CORRESPONDING  TO  PR  VALUES*/32X, * J2* , 1 P5E1 2 . 3 ) 

CAP  1 

90 

I  I  =0 

CAP  1 

91 

A  J2  =  0 . 

CAP  1 

92 

PRINT  3001 , I I , AJ 1 0, AJ2 

CAP  1 

93 

3001 

FORMAT  (110, 1 P7E i 2 . 3 ) 

CAP  1 

94 

DP=0 . 2*P0RA ( M, 1 ) 

CAP1 

95 

DO  32  1=1,5 

CAP1 

96 

32 

PA ( I )=PA( I  ) *  *  2 

CAP1 

97 

DO  40  11=1,50 

CAP  1 

98 

A J 1 = A J 1 0+ I I *DP 

CAP  1 

99 

AJ2= AMC 1 ( M ) +AMC2 ( M ) *EXP ( A J 1 /AMC3 ( M ) ) +AMC4 ( M ) * EXP ( A J 1 /AMC5 ( M ) ) 

CAP  1 

1  00 

IF  ( A J 1  .GT.  0. )  GO  TO  38 

CAP  1 

101 

PP=A J 1 **2/9. 

CAP1 

102 

DO  35  JJ=1 , 5 

CAP  1 

1  03 

A J ( J  J ) =0 . 

CAP  1 

1  04 

IF  (PP  .GE.  PA ( J J ) )  GO  TO  35 

CAP1 

105 

AJ ( J J ) =SQRT (W2(M)*(PA(JJ) -PP) ) 

CAP1 

106 

35 

CONTINUE 

CAP  1 

107 

38 

CONTINUE 

CAP  1 

1  08 

PRINT  3001 , I I , AJ 1 , AJ2, ( A J ( I ) , 1=1,5) 

CAP  1 

1  09 

40 

CONTINUE 

CAP  1 

1  10 

41 

CONTINUE 

CAP  1 

1  1  1 

RETURN 

CAP  1 

1  12 

C 

CAP1 

1  13 

c  ********  *********** 

CAP  1 

1  14 

c 

COMPUTATION  OF  STRESS 

CAP  1 

1  15 

c  ********  *********** 

CAP1 

1  16 

50 

AJ 1 0=SX+SY+SZ 

CAP1 

1  17 

P0= AJ 1 0/3 . 

CAP  1 

1  18 

NRE  =  0 

CAP  1 

1  19 

DOLD  =  DORG 

CAP  1 

120 

EPRAT1 =  EPRAT2  =  0 . 25 

CAP  1 

121 

RR  =  1  . 

CAP1 

122 

RSUM=0 . 

CAP1 

123 

IF  (DBUG1.EQ.1)  PRINT  1 052 , N , K, J ,  I H, SX, SY, S2, SXY , EX, EY,  EXY ,  TEVP , 

CAP1 

1  24 

1  2EVP, DH, DORG 

CAP1 

1  25 

1  052 

FORMAT  ( *OBEG I N  CAP  N , K, J ,  I H= *4 I 4 , *  SX, SY , S2, SXY= *  1 P4E 1 0 . 3 , 

CAP1 

1  26 

1  *  EX , EY , EXY  =  * 3E 1 0 . 3 /  1  OX, *  TEVP, 2EVP  =  *2E1 0 . 3, *  DH, DORG=  *0P2F1 0 . 6 

CAP  1 

1  27 

2  ) 

CAP  1 

1  28 

2EVT  =  ALOG ( DORG/DH) 

CAP1 

1  29 

EZ  =  ZEVT-EX-EY 

CAP  1 

1  30 

DEVT=ZEVT 

CAP  1 

131 

C 

RECOMBINATION  OF  SPALLED  MATERIAL. 

CAP  1 

1  32 

IF  (IH  .NE.  10)  GO  TO  80 

CAP1 

133 

TEVP = TEVP +ZEVT 

CAP  1 

1  34 

I F ( TEVP . GT . 0 . )  GO  TO  580 

CAP  1 

1  35 

DE3= ( ZEVT - TEVP ) /3 . 

CAP1 

1  36 

EX=EX-DE3 

CAP1 

1  37 

EY=EY -DE3 

CAP1 

138 

EZ=EZ-DE3 

CAP  1 

139 

ZEVT  =  TEVP 

CAP  1 

140 

TEVP= - 1 . 

CAP  1 

141 

I  H  =  5 

CAP  1 

142 

80 

CONTINUE 

CAP  1 

143 

AJ  20  =  SQRT ( ( (SX-PO) **2+(SY-P0) **2+(S2-P0) **2)/2. +SXY**2) 

CAP  1 

144 

EV=DEVT/3. 

CAP1 

145 

c  ********  *********** 

CAP1 

146 

c 

COMPUTE  STRESSES  ON  ELASTIC  BASIS  AND  TEST  FOR  YIELDING. 

CAP  1 

147 

BG=GH ( A J20 ) 

CAP1 

148 

SXT  = (SX-PO) +2. *BG* ( EX-EV ) 

CAP1 

149 

SYT  = ( SY -PO ) +2 . *BG* ( EY-EV ) 

CAP1 

150 

SZT  = ( SZ-PO ) +2 . *BG* ( EZ-EV ) 

CAP1 

151 

202 
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SUBROUTINE  CAP1  (Continued) 


SXYT  =  SXY  +  2 . #BG#EXY 

A J2T  =  SQRT ( (SXT##2+SYT##2+SZT**2)/2. +SXYT**2) 

ZE I T= ( AJ2T -AJ20) / ( 2 . #BG ) 

IF  (MUP2CM)  .EQ.  0.)  GO  TO  95 

AJ2T  = ( MUP ( M ) /MUP2 ( M ) +AJ20 ) #EXP ( 2 . #MUP2 ( M ) #ZE I T ) -MUP ( M ) /MUP2 ( M ) 

95  BG=GG(AJ2TJ AJ20) 

AJ2T  =  AM I N1  ( AJ2T , AJ20+2. #BG#ZEI T) 

BK=CAK(M)+AK2(M)*AJ10)*( 1 . +1 . 5*AK2 ( M ) * ZEVT* ( 1 . +AK2 ( M ) *ZEVT ) ) 

BK=  AM I N 1 (AKSOL(M) , AMAX1 (BK, AK(M) ) ) 

A J 1 T  =  A J 1 0+3 . *BK*  ZEVT 
D  =  DH 

PAT  =  A  J 1 T/3 , 

PT ■ PAT 

FI  0  =  A J20- C AMC 1  ( M ) +AMC2 ( M ) *  EXP ( A J 1 0/AMC3 ( M) ) +AMC4 ( M ) *  EXP ( A J 1 0/ 

1  AMC5CM))) 

AMC= AMC 1 (M) 

IFCAJ1T. LT. -5. * (AMC3(M)+AMC5(M) ) )G0T01  10 
AMC= - AJ 1 T 

IFCAJ1T.GT. AMC6CM) )G0T01  10 

AMC=  AMC1 ( M ) +AMC2 ( M ) *EXP ( A J 1 T /AMC3C  M ) ) +AMC4 C M ) *EXP ( AJ 1 T/ 

1  AMC5 ( M ) ) 

1 10  F 1 T  =  A J2T -AMC 

COMPUTATION  OF  F2T . 

CALL  CAPPR ( PT , ZEVP, M, DOLD, IHH,YM) 

F2T  =  AJ2T*  *2/W2 ( M ) +AJ 1 T*  *2/9 . -PT**2 
F20= AJ20*  *2/W2 ( M ) +AJ 1 0*  *2/9 . -PT**2 
IF  ( DBUG1  .EQ.  1 ) 

1  PR  I  NT  1  145, AJ1T,AJ2T,AJ10, AJ20,BK,BG, ZEVT,  ZEIT,F1T,  F2T,F10,  F20,PT 
145  FORMAT  (*  -145-  J1 T, J2T, J1 0, J20=* 1 P4E1 0. 3, *  BK , BG, ZEVT, ZEI T=* 

1  4E10.3,/  10X, *F1T,F2T,F10,F20=*4E10.3, *  PT=*E10.3) 

TEST  FOR  PURELY  ELASTIC  CASE. 

IF  C  FI T  .LE.  0.  .AND.  F2T  .LE.  0.)  GO  TO  500 

BEGIN  SUBCYCLING  LOOP  OVER  EACH  STRAIN  INCREMENT. 

N I NC  =  MAX1  (  1  .  ,  FCR1 *ABS( AJ1 T-AJ1 0) /BK, FCR2* ( AJ2T-AJ20) /BG) 

I F ( N I NC . GT . 40 . OR . DBUG1 . EQ . 1 )  PRINT  1 1 95 , K i J , N , N I NC , AJ 1 T , AJ2T , AJ 1 0 , 

1  A  J20 

195  FORMAT  (  30H  CAP  SUBCYCLING  -  K,J,N,NINC  =314,110,*  J 1 T , J2T, J 1 0, J2 
1 0=  *  1 P4E1 0.3) 

RR= 1  . /AM I  NO ( 600, N I NC ) 

N I NC=0 

SET  INITIAL  STRAIN  INCREMENT. 

200  N I NC=N I NC+1 

D=D0LD*EXP( -ZEVT*RR) 

DEVT  =ZEVT*RR 
AJ 1 0  =  SX+SY  +SZ 
PO=A J 1 0/3 . 

AJ20=SQRT ( ( (SX-PO) * *2+ ( SY -PO ) * *2+ ( SZ -PO ) * *2 ) /2 . +SXY**2) 

C  COMPUTE  STRESS  INVARIANTS. 

BK= ( AK (M ) +AK2 (M ) * AJ 1 0) * ( 1  .+1 . 5*AK2(M) *DEVT  * ( 1  . +AK2 ( M ) *DEVT ) ) 

BK=  AMIN1 (AKSOL(M) , AMAX1 (BK, AK(M) ) ) 

AJ 1 T=AJ 1 0+3 . *BK*DEVT 
PAT  =  A J 1 T /3 . 

EV=DEVT/3. 

BG=GH ( A J20 ) 

SXT= (SX-PO) +2. *BG*CEX*RR-EV) 

SYT= ( SY -PO ) +2 . #BG* (EY*RR-EV) 

SZT  = ( SZ-PO ) +2 . *BG*(EZ*RR-EV) 

SXYT  =  SXY +2 . *BG*EXY*RR 

AJ2T  =  SQRT ( ( SXT*  *2+SYT* * 2+SZT# #2 ) /2 . +SXYT* * 2 ) 

IF  (MUP2CM)  .EQ.  0)  GO  TO  205 
DE I T= ( A J2T -A J20 ) / ( 2 . *BG ) 

AJ2T  = ( MUP( M ) /MUP 2 ( M ) +AJ20 ) #EXP ( 2 . *MUP2 (M ) *DEI T ) 

1  -MUP (M ) /MUP2 (M ) 

205  BG=GG( AJ2T, AJ20) 

AJ2T= AM I N1 ( AJ2T, AJ20+2 . *BG*DEI T) 

IF  (DBUG1.EQ.1)  PRINT  1 205, AJ 1 0, AJ 1 T , AJ20, AJ2T, BK, BG, DEVT , DE I T , 

1  RR, RSUM, D, DOLD 

1205  FORMAT  (#  L0C=205  J 1 0, J 1 T, J20, J2T=* 1 P4E1 0 . 3, *  BK, BG= *2E1 0 . 3, 

1  /10X,*  DEVT , DE IT  =  *2E10.3,*  RR, RSUM=*2E1 0 . 3, *  D, DGLD=  *0P2F 10.6) 


CAP  1 

152 

CAP1 

1  53 

CAP1 

154 

CAP1 

155 

CAP1 

156 

CAP1 

157 

CAP1 

158 

CAP1 

1  59 

CAP1 

160 

CAP1 

161 

CAP  1 

162 

CAP  1 

163 

CAP  1 

1  64 

CAP  1 

165 

CAP  1 

1  66 

CAP  1 

1  67 

CAP1 

1  68 

CAP  1 

1  69 

CAP  1 

170 

CAP1 

171 

CAP  1 

172 

CAP  1 

173 

CAP1 

174 

CAP  1 

175 

CAP  1 

176 

CAP  1 

177 

CAP  1 

178 

CAP1 

1  79 

CAP  1 

1  80 

CAP1 

181 

CAP1 

1  82 

CAP1 

1  83 

CAP  1 

184 

CAP1 

185 

CAP  1 

1  86 

CAP1 

1  87 

CAP  1 

1  88 

CAP  1 

1  89 

CAP  1 

1  90 

CAP1 

1  91 

CAP1 

192 

CAP1 

1  93 

CAP  1 

1  94 

CAP  1 

1  95 

CAP  1 

196 

CAP  1 

1  97 

CAP  1 

1  98 

CAP  1 

1  99 

CAP1 

200 

CAP  1 

201 

CAP1 

202 

CAP1 

203 

CAP  1 

204 

CAP  1 

205 

CAP1 

206 

CAP1 

207 

CAP1 

208 

CAP  1 

209 

CAP1 

210 

CAP  1 

21  1 

CAP1 

212 

CAP  1 

213 

CAP  1 

214 

CAP  1 

215 

CAP  1 

216 

CAP1 

21  7 

CAP  1 

218 

CAP  1 

219 

CAP1 

220 

CAP1 

221 

CAP  1 

222 

CAP  1 

223 

CAP1 

224 

CAP  1 

225 

CAP1 

226 

203 


SUBROUTINE  CAP1  (Continued) 


c 

EVALUATE  FI  AND  F2  FROM  ELASTIC  STRESSES, 

CAP  1 

227 

AMC= AMC 1 (M) 

CAP  1 

228 

IFCAJ1T. LT. -5. * (AMC3CM) +AMC5CM) ) )G0T0215 

CAP  1 

229 

AMC  = -AJ 1 T 

CAP  1 

230 

I FCAJ1T.GT. AMC6CM) )G0T021 5 

CAP  1 

231 

AMC=  AMC1 ( M ) +AMC2 ( M ) #EXP ( A J 1 T /AMC3 ( M ) ) +AMC4 ( M) *EXP ( AJ1 T/ 

CAP  1 

232 

1  AMC5 ( M ) ) 

CAP  1 

233 

215 

F 1 T  =  AJ2T -AMC 

CAP  1 

234 

CALL  CAPPRC  PT,  ZEVP, M, DOLD,  IHH,YM) 

CAP  1 

235 

C 

COMPUTE  F2  FROM  ELASTIC  STRESSES  AND  PREVIOUS  PLASTIC  STRAIN. 

CAP  1 

236 

245 

F2T=AJ2T##2/W2(M)+AJ1 T##2/9. -PT##2 

CAP  1 

237 

DZEP  =  AM  I N1  ( -1 . E-5, DEVT ) 

CAP  1 

238 

ZEP=ZEVP+DZEP 

CAP  1 

239 

CALL  CAPPR (PZjZEPjMjDj  I  HH ,  YM ) 

CAP  1 

240 

DPDE=3 . * ( PZ##2-PT##2) /DZEP 

CAP  1 

241 

NQ  =  0 

CAP  1 

242 

IF  ( DBUG1  . EQ.  1 ) 

CAP  1 

243 

1  PR  I  NT  1 270  ,  FI T, F2T, PT, PZ, ZEP, DZEP , RR, EPRAT1 , EPRAT2 

CAP  1 

244 

1270 

FORMAT  (#  270  -  F1TJF2T,PT,PZ=#1P4E10.3J#  ZEP , DZEP= * 2E1 0 . 3 , 

CAP1 

245 

1  /10X,#  RR, EPRAT 1 , EPRAT2=  #0P3F1 0 . 6) 

CAP  1 

24  6 

IF  (FIT  .LE.  0,  .AND.  F2T  . LE .  0.)  GO  TO  500 

CAP  1 

247 

A J 1 1 = A J 1 Q+EPRAT 1  * ( A J 1 T - A J 1 0 ) 

CAP1 

248 

AJ2 1 = AJ2G+EPRAT2# ( AJ2T -AJ2Q ) 

CAP  1 

249 

c  # # * # *  *  *  *  *********** 

CAP  1 

250 

c 

COMPUTATION  OF  YIELDING  PROCESS 

CAP  1 

251 

NQ  =  1 

CAP1 

252 

BK=BKH ( AJ 1 1 ) 

CAP  1 

253 

BG=GH ( A J2 1 ) 

CAP  1 

254 

c 

CAP  1 

255 

c 

YIELD  ON  MOHR-COULOMB  SURFACE. 

CAP  1 

256 

c 

CAP  1 

257 

IFCFIT.LT.O. )  GO  TO  350 

CAP  1 

258 

I F ( ZEVT . GT . 0 . )  GO  TO  550 

CAP  1 

259 

I F  ( F2T  . GT.  0. )  GO  TO  400 

CAP  1 

260 

310 

AJ 1 =AM I N 1 (AJ1T, AMC6CM) ) 

CAP1 

261 

NC  =  0 

CAP  1 

262 

AJ2B= AJ20 

CAP1 

263 

320 

NC  =  NC+ 1 

CAP  1 

264 

TAU2=AMC2(M) #EXP( AJ1 /AMC3CM) ) 

CAP1 

265 

TAU3=AMC4(M) #EXP ( AJ 1 /AMC5 ( M ) ) 

CAP  1 

266 

AJ2= AMC1 ( M ) +TAU2+TAU3 

CAP1 

267 

IF  (LPATH  .EQ.  0)  GO  TO  330 

CAP1 

268 

D J2= AJ2- AJ2B 

CAP1 

269 

IF  (NC  .GE.  10)  GO  TO  700 

CAP  1 

270 

IF  (ABSCDJ2)  .LT.  DFCR1  .AND.  NC  . GT .  1)  GO  TO  330 

CAP  1 

271 

XI 1 =TAU2/AMC3(M)+TAU3/AMC5(M) 

CAP1 

272 

BK=  BKK ( AJ 1 , AJ10) 

CAP  1 

273 

BG=GG ( A  J2 , A J20 ) 

CAP  1 

274 

X I B= AMC2 ( M ) #EXP ( (AJ1 +AJ1 0) / ( 2 . #AMC3(M) ) )/AMC3(M) 

CAP1 

275 

1  +AMC4 ( M ) #EXP ( ( A J 1 +A J 1 0 ) / ( 2 . #AMC5(M) ) )/AMC5(M) 

CAP1 

276 

D J= ( AJ2T-AJ2+ ( AJ 1 T-AJ 1 ) #BG/(9. *BK#X I B ) ) / (XI 1+BG/C9. #BK*XIB) ) 

CAP1 

277 

IF  ( DBUG1  .EQ.  1)  PRINT  1 320, NC, AJ1 , AJ2, DJ2, DJ, TAU2, TAU3, XI 1 , BK, BG 

CAP1 

278 

1  320 

FORMAT  (#  M-C  NC^I2,*  J1  ,J2,DJ2,DJ=#1P4E12.5,#  TAU,XI,K,G=# 

CAP1 

*  279 

1  5E10.3) 

CAP  1 

280 

AJ2B=AJ2 

CAP1 

281 

A J 1 = AJ 1 +D J 

CAP  1 

282 

GO  TO  320 

CAP  1 

283 

330 

F21 = AJ2#  #2/W2 (M ) +AJ 1 #*2/9.  -PT##2 

CAP  1 

284 

IF  ( DBUG1  .EQ.  1)  PRINT  1 330 , AJ 1 , AJ2 , A J2A, F2 1 , FI T 

CAP  1 

285 

1330 

FORMAT  (#  M-C  END,  J 1 , J2 , J2A= *  1 P3E 1 2 . 5 , #  F21 , FI T= #2E1 0 . 3 ) 

CAP1 

286 

IF  (F21  .GT.  0. )  GO  TO  410 

CAP  1 

287 

I  H  =  6 

CAP  1 

288 

GO  TO  600 

CAP1 

289 

C 

CAP  1 

290 

C 

YIELD  ON  THE  CAP  SURFACE 

CAP  1 

291 

C 

CAP1 

292 

350 

BB  =  0. 

CAP  1 

293 

A J 1 0P= A J 1 0 

CAP  1 

294 

A J20P= A J20 

CAP  1 

295 

IF  (IH  .EQ.  7  .OR.  IH  . EQ .  8)  GO  TO  353 

CAP1 

296 

AJ1 0P=SIGN(PT#AJ1 T/SQRTCAJ1 T##2/9. +AJ2T##2/W2 (M) ) , AJ 1 T ) 

CAP  1 

297 

AJ20P=SQRT(W2(M)#AMAX1 (0. , PT# *2-AJ1 0P##2/9 . ) ) 

CAP  1 

298 

ZEP=ZEVP+AM I N 1 (0. , DEVT- ( A J 1 OP-AJ 1 0 ) /BK ) 

CAP  1 

299 

CALL  CAPPRCPZ, ZEP, M, D, IHH,YM) 

CAP1 

300 

353 

IF  ( ABS ( A J 1 T-AJ 1  OP )  . GE .  1.)  BB= ( PZ -PT ) / ( AJ 1 T -AJ 1  OP ) 

CAP  1 

301 

204 


SUBROUTINE  CAP1  (Continued) 


I  H  =  7 

CAP  1 

302 

I  LC=  1 

CAP  1 

303 

I  H  I  =2 

CAP1 

304 

c 

FIRST  ESTIMATE  OF  J 1 

CAP1 

305 

NCAP= 1 

CAP  1 

306 

I  NT  = I LO 

CAP1 

307 

A J 1 =AJ 1  OP* ( 1  . +BB/(PT+BB*AJ1 OP) * (3. * DEVT#BKH ( AJ 1  OP) ) ) 

CAP1 

300 

c 

COMPUTATION  OF  J2  AND  ERROR  DLA 

CAP1 

309 

355 

BK=BKK ( AJ 1 , AJ 1 0) 

CAP1 

31  0 

DZEP= AM I N1 (0.  , DEVT- ( AJ 1 -AJ10)/(3. *BK ) ) 

CAP1 

31  1 

CALL  CAPPR ( PR , ZEVP+DZEP  ,  M ,  D ,  I H , YM ) 

CAP1 

312 

AJ 1 = AMAX1 ( A J 1 , 3. 3*PR) 

CAP1 

313 

PJ  =AM I N1  (ABSCAJ1  ) , ABS(AJ1 -6. #PR) )/3. 

CAP  1 

314 

AJ2=0. 

CAP  1 

315 

IF  (PR**2-PJ#*2  .GT.  1  .  ) 

CAP  1 

31  6 

1AJ2=SIGN(SQRT(W2(M)*(PR**2-PJ**2) ) , AJ1 -3. *PR) 

CAP  1 

317 

BG=GG ( ABS ( AJ2 ) , AJ20) 

CAP  1 

310 

IF  (IH  .EQ.  9  .AND.  NCAP  .GE.  3)  GO  TO  400 

CAP  1 

319 

DE I P=DE I T - ( AJ2-AJ20P ) / ( 2 . #BG ) 

CAP  1 

320 

DLA=DE I P - 1 . 5*(AJ2+AJ20P)*DZEP/(W2(M)*CAJ1 +AJ1 OP) ) 

CAP  1 

321 

AJ A=AJ 1 

CAP  1 

322 

IF  ( DBUG1  . EQ.  1 ) 

CAP  1 

323 

1  PR  I  NT  1 365 j NCAP , AJ 1 ,  AJ2, DLA, BG, DEI P, PJ , PR 

CAP  1 

324 

1  365 

FORMAT  (*  365  NCAP=*I3,*  J 1 , J2= *  1 P2E1 3 . 6 , *  DLA,  BG ,  DEI  P,  PJ 

,  PR  =  * 

CAP  1 

325 

1  5E10.3) 

CAP1 

326 

IF  (2. *ABS(DLA) *BG  .LT.  DFCR1 )  GO  TO  390 

CAP  1 

327 

IF  (NCAP  .GE.  30)  GO  TO  700 

CAP  1 

320 

IF  (NCAP-2)  350,360,370 

CAP  1 

329 

C 

SECOND  ESTIMATE  OF  J1 

CAP  1 

330 

350 

IF  (ABS(AJI)  .LE.  1.E4)  AJ 1 = - 3 . *SQRT ( AMAX1 ( 0 . J PT* *2“AJ2T* *2/ 

CAP1 

331 

1  W2 ( M ) )  ) 

CAP  1 

332 

DJ2=2 . *DLA*BG 

CAP  1 

333 

IF  (ABSCAJ1)  .GT.  1 . E4 )  AJ 1 = -9 . /W2 ( M ) *ABS ( A J2 ) /AJ 1 *D J2  + 

AJ  1 

CAP1 

334 

GO  TO  302 

CAP1 

335 

360 

I  NT  = I LO 

CAP1 

336 

IF  ( DL ( I LO ) *DLA  .LT.  0.)  GO  TO  375 

CAP1 

337 

I  NT* I  HI 

CAP  1 

330 

IF  ( AMAX1 (DLC I LO) , DLA)  .LT.  0.)  GO  TO  366 

CAP  1 

339 

C 

MOST  TENSILE  ESTIMATE  OF  J1 

CAP! 

340 

AJ 1 = -3 . *SQRT ( AMAX1 (0.  , PT  *  *2-AJ2T  *  *2/W2 (M) ) ) 

CAP  1 

341 

AJ 1 =0 . 5* ( AJ 1 +AMAX1 (AJ1T,AJ10) ) 

CAP1 

342 

GO  TO  3e2 

CAP  1 

343 

C 

MOST  COMPRESSIVE  ESTIMATE  OF  J1 

CAP  1 

344 

366 

AJ1 =3. #PT 

CAP  1 

345 

IF  ( ABS ( DEVT )  .LT.  1.E-7)  GO  TO  370 

CAP  1 

346 

DEVZP=DEVT- ( PZ-AJ 10/3. ) /BKK ( AJ 1 0, 3 . *PZ) 

CAP1 

347 

DEVTP = DEVT- ( PT - AJ 1 0/3 . ) /BKK ( A J 1 0 , 3 . *PT) 

CAP1 

340 

DEVP= DEVTP* DEVT / ( DEVT +DEVTP -DEVZP ) 

CAP  1 

349 

AJ1 =3. *(PT+(PZ-PT) * DEVP /DEVT ) 

CAP  1 

350 

IF  (DBUG1  .EQ.  1) 

CAP  1 

351 

1  PRINT  1 357, NCAP, AJ 1  OP , AJ20P, AJ 1 0, AJ2, DEVZP , DEVTP , DEVP , A J 1 

CAP1 

352 

1357 

FORMAT  (*  357  NCAP=*I3,*  AJ1  OP,  AJ20P,  AJ1  0,  AJ2  =  *  1  P4E1  0 . 3/ 

CAP1 

353 

1  *  DEVZP, DEVTP, DEVP, AJ 1=*4E10.3) 

CAP1 

354 

GO  TO  302 

CAP1 

355 

370 

I  NT  = I H I 

CAP  1 

356 

C 

REGULA  FALSI  CALCULATION  OF  J1 

CAP  1 

357 

IF  (DL(ILO)  .GT.  0.  .OR.  (DL(IHI)  . GT .  0.  .AND.  DLA  . GT . 

0.  )  ) 

CAP  1 

350 

1  I  NT ■ I LO 

CAP  1 

359 

375 

A J 1 =  AJA- ( AJ ( I  NT) -AJA ) / ( DL ( I  NT ) -DLA) *DLA 

CAP  1 

360 

IF  ( MOD ( NCAP, 5 )  . EQ .  0)  AJ 1  =  ( AJ 1 +AJA+AJ ( I  NT) ) /3 . 

CAP  1 

361 

C 

STORAGE  OF  RESULTS  OF  PREVIOUS  ITERATIONS 

CAP  1 

362 

I  NT  = I H I 

CAP1 

363 

IF  (NCAP  .EQ.  2)  GO  TO  302 

CAP  1 

364 

IF  ((DL(IHI)  .GT.  0.  .AND.  DLA  . GT .  DL ( I  HI ) )  .OR.  (DLA  .LT. 

CAP1 

365 

1  DL(ILO)  .AND.  DL(ILO)  .LT.  0.))  GO  TO  305 

CAP  1 

366 

IF  (DL(ILO)  .GT.  0.  .OR.  (DL(IHI)  . GT .  0.  .AND.  DLA  .GT. 

0.  )  ) 

CAP  1 

367 

1  GO  TO  302 

CAP  1 

360 

I  NT  = I LO 

CAP  1 

369 

302 

DL ( I  NT ) =DLA 

CAP1 

370 

AJ ( I  NT ) = AJA 

CAP1 

371 

IF  (NCAP  .EQ.  1 )  GO  TO  305 

CAP1 

372 

IF  (DL(IHI)  .GT.  DL(ILO))  GO  TO  305 

CAP  1 

373 

I  NT  = I H I 

CAP  1 

374 

I H I = I LO 

CAP  1 

375 

I L0= I  NT 

CAP  1 

376 
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SUBROUTINE  CAP1  (Continued) 


385 

CONTINUE 

CAP  1 

377 

NCAP=NCAP+1 

CAP  1 

378 

IF  ( DBUG1  .EQ.  1) 

CAP  1 

379 

1  PR I  NT  1 385,  NCAP ,  I H I ,  I LO , AJ ( n , AJ ( 2 ) , DL ( 1 ) , DL ( 2 ) 

CAP  1 

380 

1  385 

FORMAT  (*  385  NCAP»*I3,*  HI,L0=*2I2,*  AJ , DL= *  1 P4E1 0 . 3 ) 

CAP1 

381 

GO  TO  355 

CAP1 

382 

C 

CHECK  FOR  CONVERGENCE  TO  POINT  ABOVE  THE  M-C  CURVE 

CAP  1 

383 

390 

FI  1  =AJ2~ ( AMC1 (M)+AMC2(M) *EXP(AJ1 /AMC3CM) ) +AMC4 ( M ) * EXP ( AJ 1 / 

CAP  1 

384 

1  AMC5 ( M ) ) ) 

CAP  1 

385 

DJ2  =  2 . *  DLA*BG 

CAP  1 

386 

IF  (ABS(AJI)  .GE.  1.E4)  AJ 1 = -9 . /W2 (M) *ABS( AJ2 ) /AJ 1 *DJ2  +AJ1 

CAP  1 

387 

AJ2=AMAX1 (0.  , AJ2+DJ2) 

CAP  1 

388 

IF  (FI  1  .LT.  DFCR1 )  GO  TO  600 

CAP  1 

389 

IF  ( DBUG1  .EQ.  1 ) 

CAP  1 

390 

1  PR I  NT  1 390 j  NCAP j  A J 1 j  AJ2 , FI  1 

CAP  1 

391 

1390 

FORMAT  (*  390  SKIP  TO  JOINT,  NCAP=*I3,*  J 1 , J2, FI  1 =* 1 P3E1 0 . 3 ) 

CAP  1 

392 

GO  TO  418 

CAP  1 

393 

C 

CAP  1 

394 

0 

YIELD  AT  JOINT  OF  CAP  AND  MOHR-COULOMB 

CAP  1 

395 

C 

CAP1 

396 

400 

IF  ( IH  . NE.  8)  GO  TO  350 

CAP1 

397 

CR I T= ( A J2T-AJ20 ) *W2 ( M ) *BK* AJ 1 0 

CAP  1 

398 

CRI T2= (AJ1 T-AJ1 0) *BG*AJ20 

CAP1 

399 

IF  ( DBUG1  .EQ.  1) 

CAP  1 

400 

1  PR I  NT  1405, CRIT, CRIT2,AJ10,AJ20 

CAP  1 

401 

1405 

FORMAT  (*  405  CRI T , CR I T2= *  1 P2E1 0 . 3, *  AJ10,AJ20=*2E1 0. 3) 

CAP1 

402 

IF  (CRIT  .GT.  CRIT2)  GO  TO  350 

CAP1 

403 

410 

DF1 1 =-AMC2(M)/AMC3(M) *EXP(AJ1 1 /AMC3(M) ) -AMC4 (M ) /AMC5 (M ) *  EXP ( AJ 1 1 / 

CAP1 

404 

1  AMC5 (M ) ) 

CAP1 

405 

DF2 1 =2. /9. * AJ 1 1 

CAP  1 

406 

DF22=2 . #AJ21 /W2(M) 

CAP  1 

407 

DET  =  9 . #BK# ( DF1 1 *DF22-DF21 ) -DPDE 

CAP1 

408 

AJ 1 = -DPDE* ( A J 1 T-AJ 1 0 ) /DET  +  A J 1 0 

CAP  1 

409 

AJ2=DPDE*DF1 1  * ( AJ 1 T-AJ 1 0 ) /DET  +  AJ20 

CAP  1 

410 

A J2=AMAX 1 (0. , AJ2 ) 

CAP1 

41  1 

IF  ( DBUG1  .EQ.  1) 

CAP1 

412 

1  PRINT  1908, AJ1 , AJ2, AJ 1 0, AJ20, DF1 1  ,DF21 ,DF22,DPDE 

CAP  1 

413 

1908  FORMATC*  JOINT  418  -  AJ 1 , AJ2 , AJ 1 0 , AJ20  =*,1P4E10.3/ 

CAP  1 

414 

1  *  DF1 1 , DF21 , DF22, DPDE  =*,4E10.3> 

CAP1 

415 

DEP=DEVT- ( AJ 1 -AJ 1 0 ) / ( 3 . *BK) 

CAP  1 

416 

418 

NMC  =  0 

CAP  1 

417 

420 

NMC  =  NMC*M 

CAP1 

418 

I  H  =  8 

CAP1 

419 

TAU2=TAU3=0. 

CAP1 

420 

IF  ( AJ 1  .LT.  -10. *AMAX1 ( AMC3 (M ) , AMC5 (M) ) )  GO  TO  430 

CAP1 

421 

AJ  J  =AJ 1 

CAP  1 

422 

IF  ( AJ 1  .GT.  AMC6(M) )  AJJ=AMC6(M) 

CAP1 

423 

TAU2=AMC2(M) *EXP ( AJ J/AMC3 ( M ) ) 

CAP  1 

424 

TAU3  =  AMC4 ( M ) *  EXP ( AJ J/AMC5 ( M ) ) 

CAP1 

425 

430 

AJ2  =AMC1 ( M ) +TAU2+TAU3 

CAP1 

426 

AJ2=AMAX 1 (0. , AJ2 ) 

CAP1 

427 

XI 1 =TAU2/AMC3 ( M ) +TAU3/AMC5 ( M ) 

CAP1 

428 

XI  2  =  TAU2/AMC3(M)  * *2+TAU3/AMC5 ( M )  **2 

CAP1 

429 

DZEP=DEVT- ( AJ 1 -AJ10)/(3. *BK) 

CAP  1 

430 

ZEP=ZEVP+AM I N 1 (0. , DZEP ) 

CAP1 

431 

CALL  CAPPR ( PR, ZEP, M, D , IH,YM) 

CAP1 

432 

IF  ( IH  . EQ.  9)  GO  TO  480 

CAP  1 

433 

YM=YM/(3. #BK) 

CAP1 

434 

IF  ( ABS( SQRT ( AJ 1 **2/9 . +AJ2**2/W2 ( M) ) +PR )  . LT .  DFCR1 )  GO  TO  600 

CAP  1 

435 

475 

DJ  =  0 . 5* ( AJ2  *  *2/W2 ( M ) +AJ 1 **2/9. -PR**2)/( -AJ2  *X1 1 /W2 (M ) -AJ 1 /9 . + 

CAP  1 

436 

1  PR* YM ) 

CAP  1 

437 

DJA=DJ 

CAP1 

438 

AAA= ( X I 2*DJ ) * *2/W2 ( M ) +2 . *XI 1  *X I 2*DJ/W2 ( M ) +X I 1  * *2/W2 ( M ) +2 . *AJ2*XI2 

CAP  1 

439 

1  /W2 ( M ) +0 . 11111 -YM**2 

CAP  1 

440 

BBB=2 . * ( AJ2  #XI 1/W2(M)+AJ1/9. -PR*YM) 

CAP  1 

441 

CCC= AJ2  **2/W2(M)+AJ1 **2/9. -PR* *2 

CAP1 

442 

IF  (BBB**2-4. *AAA*CCC  . GT .  0.) 

CAP  1 

443 

1 DJ  =  0 . 5*BBB/AAA* ( SQRT ( 1.-4. * AAA*CCC/BBB* *2 ) - 1  .  ) 

CAP  1 

444 

AJ 1 = AM I N 1 (AJ10, AJ1+DJ) 

CAP  1 

445 

CR I T  =  SQRT ( AJ2*  *2/W2 ( M ) +AJ 1  *  *2/9 .  ) 

CAP1 

446 

IF  ( DBUG1  .EQ.  1 ) 

CAP1 

447 

1  PR I  NT  1480, AJ1 , DJ, DJA, AJ2, CRIT, PR, AAA,BBB, CCC 

CAP  1 

446 

1480 

FORMAT  (*  480  AJ 1 , DJ , DJA= *  1 P3E 1 0 . 3, *  AJ2, CRI T, PR  =  *3E1 0 . 3, 

CAP  1 

449 

1  *  AAA, BBB, CCC=*3E10.3) 

CAP  1 

450 

I F ( NMC . GE .  5)  GO  TO  700 

CAP  1 

451 

206 


SUBROUTINE  CAP1  (Continued) 


IFCNMC.GT. 1 )  GO  TO  420 

CAP1 

452 

BK=BKK ( AJ 1 , AJ10) 

CAP  1 

453 

BG=GG ( AJ2 j AJ20 ) 

CAP1 

454 

GO  TO  420 

CAP1 

455 

480 

AJ1 =3. *  PR 

CAP  1 

456 

AJ2=AM I N 1  ( AJ2  j  AMC1  (M)  ) 

CAP  1 

457 

GO  TO  600 

CAP1 

458 

c  ********  *********** 

CAP  1 

459 

c 

COMPLETION  OF  STRESS  CALCULATION  FOR  ELASTIC  CASE 

CAP  1 

460 

500 

AJ 1 =  A  J 1 T 

CAP  1 

461 

P=AJ1/3. 

CAP  1 

462 

SX=SX-P0+2 . #BG# ( EX*RR-DEVT/3 . )+P 

CAP  1 

463 

SY=SY -P0+2 . *BG*(EY*RR-DEVT/3.  ) +P 

CAP  1 

464 

SZ= AJ 1 -SX-SY 

CAP  1 

465 

SXY  =  SXY+2 .  *BG*EXY*RR 

CAP  1 

466 

AJ2= A J2T 

CAP  1 

467 

I  H=  5 

CAP  1 

468 

GO  TO  630 

CAP1 

469 

C 

********** 

CAP  1 

470 

C 

TENSILE  FAILURE  ON  THE  M0HR-C0UL0MB  SURFACE 

CAP  1 

471 

550 

A J 1 =  AM I N 1  ( AJ 1 T  j  AMC6 ( M ) ) 

CAP  1 

472 

AJ2=AMC 1 (M)+AMC2(M) *EXP(AJ1 /AMC3CM) ) +AMC4 ( M) *EXP( AJ 1 /AMC5( M) ) 

CAP  1 

473 

P=AJ1/3. 

CAP  1 

474 

SXD=SX-P0+2. #BG# ( EX -ZEVT /3 . )#RR 

CAP  1 

475 

SYD=SY -P0+2 . #BG*(EY-ZEVT/3. )*RR 

CAP  1 

476 

SZD=SZ-P0+2. *BG* (EZ-ZEVT/3. ) *RR 

CAP  1 

477 

SXYD  =  SXY +2 . #BG#EXY*RR 

CAP  1 

478 

AJ  2T  =  SQRT ( 0 . 5* ( SXD* * 2+SYD* * 2+SZD* *2) +SXYD**2) 

CAP  1 

479 

FAC= A J2/AMAX 1 ( 1 . J AJ2T) 

CAP1 

480 

SX=SXD*FAC+P 

CAP  1 

481 

SY  =SYD#FAC+P 

CAP  1 

482 

SZ=SZD*FAC+P 

CAP1 

483 

SXY=SXYD*FAC 

CAP  1 

484 

DEPT  =  SQRT ( (EX**2+EY**2+EZ**2) /2. +EXY**2) *RR*(AJ2T~AJ2)/ 

CAP  1 

485 

1  CAJ2T+1 . ) 

CAP  1 

486 

I F ( TEVP  . EQ.  -1 . )TEVP=0. 

CAP  1 

487 

TEVP=TEVP+DEPT 

CAP  1 

488 

I  H  =  6 

CAP  1 

489 

SMAX= AMAX 1  (  (SX+SY+SGRTC4  .  *SXY*  *2+(  SX-SY  )  **2)  )/2.  SZ) 

CAP1 

490 

IF  (TEVP  .GT.  DAMG(M)  .AND,  SMAX  . GE .  SCRIT(M)  .AND.  AJ 1  . GE .  0.) 

CAP  1 

491 

1  GO  TO  570 

CAP  1 

492 

ZEVP= ZEVP+AM I N1 (0. , ZEVT*RR-(AJ1 -A J 1 0 ) /BK/3 . ) 

CAP  1 

493 

GO  TO  630 

CAP  1 

494 

570 

CONTINUE 

CAP  1 

495 

ENU= ( 3 . -2. *BG/BK ) / ( 6 . +2 , *BG/BK) 

CAP  1 

496 

EM0D=2 . * ( 1 . +ENU ) *BG 

CAP  1 

497 

DEX= ( SX-ENU# ( SY+SZ) ) /EMOD 

CAP  1 

498 

DEY=  C  SY -ENU# ( SX+SZ) ) /EMOD 

CAP1 

499 

DEZ= ( SZ-ENU* ( SX+SY ) ) /EMOD 

CAP1 

500 

DEXY=SXY/2 . /BG 

CAP1 

501 

DEPF=SQRT ( ( DEX*#2+DEY**2+DEZ##2) /2, +DEXY**2) 

CAP1 

502 

IF  (TEVP  .EQ.  “1  .  )  TEVP  =  0 . 

CAP  1 

503 

TEVP=TEVP+DEPF+ ( 1 . -RSUM ) /RR*DEPT 

CAP  1 

504 

580 

sx=o. 

CAP1 

505 

SY  =  0 . 

CAP1 

506 

sz=o. 

CAP1 

507 

SXY  =  0 . 

CAP  1 

508 

AJ1 =0. 

CAP  1 

509 

AJ2=0 . 

CAP  1 

51  0 

D  =  DH 

CAP1 

51  1 

RR= 1 . -RSUM 

CAP  1 

51  2 

ZEVP= ZEVP+AM I N 1 (0. , ZEVT*RR- ( AJ 1 -AJ 1 0 ) /AK ( M ) /3 . ) 

CAP  1 

51  3 

IF  (IH  .NE.  10)  PRINT  ISSO.K.J.N 

CAP  1 

514 

1590 

FORMAT  ( 22H  SEPARATION  AT  CELL  *<=13,4^  J=I3J9H  ON  CYCLE  1 4 ) 

CAP  1 

51  5 

I  H=  1  0 

CAP1 

516 

GO  TO  630 

CAP1 

517 

c  ********  *********** 

CAP1 

51  8 

c 

COMPUTE  STRESSES  AT  END  OF  ITERATIONS 

CAP1 

519 

600 

CONTINUE 

CAP1 

520 

AJ2  =  AMAX1  (0. j  AJ2 ) 

CAP1 

521 

DEP=DEVT- ( AJ 1 -A J 1 0 ) / ( 3 , *BK) 

CAP1 

522 

ZEVP  =  ZEVP+AM I N1  (0.  ,DEP) 

CAP1 

523 

P=AJ 1 /3 , 

CAP1 

524 

EV= ( EX+EY+EZ) /3 . 

CAP1 

525 

SXD=SX -P0+2 . #BG# ( EX-EV ) ^RR 

CAP  1 

526 
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SUBROUTINE  CAP1  (Concluded) 


SYD=SY -P0+2 . *BG* (EY-EV) *RR 

CAP  1 

527 

SZD=SZ-P0+2. *BG* (EZ-EV) *RR 

CAP1 

528 

SXYD  =  SXY +2 . *BG*EXY*RR 

CAP  1 

529 

A J2T  =  SQRT ( 0 . 5* ( SXD* *2+SYD* *2+SZD* * 2 ) +SXYD* *2 ) 

CAP  1 

530 

FAC= A J2/AMAX1 ( 1 . , A J2T ) 

CAP1 

531 

SX=SXD*FAC+P 

CAP1 

532 

SY=SYD*FAC+P 

CAP  1 

533 

SZ=SZD*FAC+P 

CAP  1 

534 

SXY  =SXYD*FAC 

CAP  1 

535 

c  ********  *********** 

CAP  1 

536 

c 

PREPARE  FOR  NEXT  SUBCYCLE 

CAP  1 

537 

630 

CONTINUE 

CAP  1 

538 

RSUM=RSUM+RR 

CAP1 

539 

IF  (DBUG1.EQ.1)  PRINT  1 630, K, J, RR, RSUM; SX, SY, SZ, SXY, AJ1 , AJ2, D, 

CAP  1 

540 

1  DOLD,  I  H ,  ZE\/T ,  ZE  I  T ,  ZEVP ,  TEVP 

CAP  1 

541 

1630 

FORMAT  (*  --FI NAL--K, J  =  *21 3, *  RR, RSUM=#2F8 . 5, *  SX, SY , SZ, SXY= * 

CAP  1 

542 

1  1 P4E 1 0.3, /4X , *  AJ1 , AJ2=*2E1 3. 6, *  D , DOLD=  *0P2F1 0.6,*  IH=*I2, 

CAP  1 

543 

2  *  ZEVT,  ZEI  T,  ZEVP,  TEVP=*  1  P4E1  0.3) 

CAP  1 

544 

I F ( 1 . -RSUM.LT. 1 .E-10)  RETURN 

CAP1 

545 

IF  (ABS(AJIT-AJIO)  .GT.  1.)  EPRAT 1 = AMAX1 ( - 1  .  , AM  I N 1 ( 1  . , 

CAP  1 

546 

1  ( A J 1 -AJ10)/(AJ1T-AJ10) ) ) 

CAP  1 

547 

IF  ( ABS (AJ2T-AJ20)  .GT.  1.)  EPRAT2= AMAX 1 ( - 1 . , AM I N 1 ( 1 . , 

CAP  1 

548 

1  ( A J2- A J20 ) / ( A J2T-A J20 ) ) ) 

CAP  1 

549 

RR  =  AM  I N 1  (1  .  -RSUM,  1  .3*RR) 

CAP  1 

550 

DOLD=D 

CAP  1 

551 

IF  (NINC  .LT.  NMAX )  GO  TO  200 

CAP  1 

552 

PRINT  1630,K, J,RR, RSUM, SX, SY , SZ, SXY ,  A  J 1 , AJ2, D, DOLD , IH, ZEVT, 

CAP1 

553 

1  ZEIT, ZEVP, TEVP 

CAP1 

554 

PRINT  1 650, N I NC 

CAP  1 

555 

1650 

FORMAT  (*  STOP  CALLED  FOR  NMAX=N I NC=* I 4 ) 

CAP  1 

556 

STOP  3121 

CAP1 

557 

c  ********  ******** 

CAP1 

558 

c 

CUT  STRAIN  INCREMENT  AND  RESTART 

CAP1 

559 

c 

CAP1 

560 

700  RR  =  0 . 5*RR 

CAP1 

561 

NRE=NRE+1 

CAP  1 

562 

IF(NRE.GE.I)  PRINT  1 700, NRE, N, K, J , DH , DOLD , DORG, RR , SX, SY , SZ, SXY  , 

CAP1 

563 

2  EX, EY, EZ, EXY, ZEVP, TEVP, I H , A J 1 , A  J2, Fl 1 , F21 , AJ10, AJ20, F10, F20, 

CAP1 

564 

2  FIT, F2T , DPDE 

CAP  1 

565 

EPRAT1 =EPRAT2=0 . 1 

CAP1 

566 

IFCNRE.GE. 10)  STOP  3120 

CAP1 

567 

GO  TO  200 

CAP1 

568 

c  ********  *********** 

CAP1 

569 

1020 

FORMAT  (4 ( 2A5, El  0 . 3) ) 

CAP1 

570 

1  021 

FORMAT  ( 1 H+, 8 OX, 3H I N= I 2, 4H  CAP) 

CAP1 

571 

1022 

FORMAT  ( 2A5, 7E 10.3) 

CAP1 

572 

1024 

FORMAT  ( 2A5,  110, 2A5,  110, 2A5, El  0. 3, 2A5, El  0. 3) 

CAP1 

573 

1040 

FORMAT  ( 4 ( 2A5 ,  1  PE 1 0 . 3 ) ) 

CAP1 

574 

1042 

FORMAT  (2A5, 1P7E10.3) 

CAP  1 

575 

1044 

FORMAT  ( 2A5,  110, 2A5,  I 10,2A5,  1  PE  1 0 . 3, 2A5 , E 1 0 . 3 ) 

CAP1 

576 

1700 

FORMAT  (*  RESTART  WITH  NRE,N,K,J=*  12,15,213,*  DH, DOLD, DORG , RR= * 

CAP  1 

577 

1  4F15.10/*  SX, SY , SZ, SXY=# 1 P4E1 0 . 3, *  EX , EY , EZ, EXY= *4E 1 0 . 3/ 

CAP  1 

578 

2  *ZEVP, TEVP,  IH=*2E10.3,I5,*  AJ 1 , AJ2= *2E1 0 . 3, *  FI  1 , F2 1 = *2E 1 0 . 3 

CAP1 

579 

3  /*  AJ1 0,AJ20, F10, F20=*4E10. 3, *  FIT, F2T, DPDE=*3E10,3) 

CAP  1 

580 

END 

CAP1 

581 
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SUBROUTINE  CAPPR 


SUBROUTINE  CAPPR ( P , EP , M , D , I H , YM ) 

CAP  1 

582 

c 

CAP  1 

583 

COMMON  /EQS/EQSTC ( 6 ) , EQSTD (  6 )  , EQSTE ( 6 ) , EQSTG (  6 )  , EQSTH ( 6 )  , EQSTN (6), 

CAP1 

584 

1  EQSTS ( 6 )  , RHO ( 6 )  , RHOS ( 6 ) , YC ( 6 ) , YAD ( 6 ) , MU(6) , ESC (6,20), CLIN, CQSQ, 

CAP1 

585 

2  TRIO, AMAT(6J4) , SP( 6) , G2( 6) , PM  I N( 6) 

CAP1 

586 

COMMON  /POR/  P0RA(6, 5) , P0RBC6, 5) , P0RCC6, 5) , EVPC6, 5) 

CAP  1 

587 

c 

CAP1 

588 

P  =  PORA ( M ,  1 ) 

CAP  1 

589 

IF  (EP  .GE.  -1*.  E-6)  GO  TO  145 

CAP  1 

590 

NC  =  5 

CAP1 

591 

IF  (EP  .LT.  EVP (M, 5) )  GO  TO  130 

CAP1 

592 

NC  =  0 

CAP1 

593 

125 

NC=NC+ 1 

CAP1 

594 

IF  (EP  .LT.  EVP(MjNC))  GO  TO  125 

CAP1 

595 

130 

P= ( PORA ( Mj NC )  +  ( PORB ( M , NC)+PORC(MJ  NC)*EP)*EP) 

CAP  1 

596 

YM= - ( PORB ( M , NC ) +2 . *EP*paRC(M, NC) ) 

CAP1 

597 

IF  (D  .LT.  RHOS ( M ) )  GO  TO  145 

CAP  1 

598 

EMU=D/RHOS(M) -1 . 

CAP1 

599 

PS = EMU* ( EQSTC ( M ) +EMU# ( EQSTD ( M ) +EMU# EQSTS ( M) ) ) 

CAP1 

600 

IF  (PS  .LT.  -P)  GO  TO  145 

CAP1 

601 

YM= -D* EQSTC ( M ) /RHOS ( M ) 

CAP  1 

602 

P=-PS 

CAP  1 

603 

I  H  =  9 

CAP  1 

604 

145 

RETURN 

CAP  1 

605 

END 

CAP  1 

606 

209 


SUBROUTINE  DEPOS 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 


c 

c 


c 

c 


c 


c 


c 


c 


SUBROUTINE  DEPOS(NPARTJ IN) 

THIS  ROUTINE  USED  WITH  SRI  GENRAT . 

CALLED  BY  GENRAT  FOR  RADIATION  DEPOSITION  CALCULATIONS. 

ROUTINE  IS  SEPARATED  INTO  3  PARTS  BY  INDICATOR,  NPART,  TO 

1  READ  DATA  ON  MATERIAL  ABSORPTION  PROPERTIES 

2  READ  SPECTRUM  AND  DEPOSIT  ENERGY  INTO  SS  ARRAY. 

3  PRINT  OUT  COORDINATE  ARRAYS  IN  DEPOSITION  EDIT 
INPUT  - 

*  TWO  FORMAL  PARAMETERS 

*  READS  ABSORPTION  SPECTRA,  RADIATED  SPECTRA  FROM  CARDS. 

OUTPUT  - 

*  FILLS  SS  ARRAYS. 

*  SETS  #SSTOPM# ,  * JSTAR* ,  *NSPEC*. 

*  WRITES  DEPOSITION  EDIT. 

THIS  IS  A  VERSION  MODIFIED  TO  ACCEPT  THE  ABSORPTION  COEFFICIENT 
DATA  DIRECTLY  FROM  FSCATT . 

I NTEGER  H, POROUS, PRESS, R I NTER , SOL  ID, SPALL 
REAL  MATL, NEM, NET, NEMH, NETH 
MISCELLANEOUS 

COMMON  AZEROC 1 ) , CEF, CKS, DAVG, DELTIM, DISCPT( 1 0) , DOLD, DRHO, DTMAX, 

1  DTMIN, DTN, DTNH, DU, DX, EOLD, F, FAC, F I RST , J , JCYCS , J I N I T, 

2  JFI N, JREZON ( 15), JSMAX, JSTAR, JTS, LSUBC3D) , M, MAXPRC  3D) , N, NCYCS, 

3  NEDI T, NPERN, NR, NREZON , NS CRB ( 6 ) , NSEPRAT, NSPALL, NTEDT, 

4  NTEX, NTR ( 15), POLD, P6 ( 20) , R ( 3D ) , RLAST, SLAST, SMAX, TED  I T ( 5D ) , 

5  TF, TI ME, TJ, TREZON, TS, T6( 20) , ULAST, UOLD, UZERO, XLAST, XNOW, XOLD 

1  , X JD I T ( 20 )  ,  MS 

HALFSTEP  VALUES 

COMMON  DH, DHLAST , DUH, EH, PH, RH, RHLAST, SH, SHLAST, UH, UHLAST, XH, XHLAST 
1  , NEMH, NETH 

CONDITION  INDICATORS 

COMMON  I NF, LI NTER, MIRROR, NORMAL, POROUS, PRESS , RI NTER,  SOLI D,  SPALL 
CELL  LAYOUT 

COMMON  DXXC3D) , JBNDC30) , JMATC3D) , NAUTO , MATL ( 6, 2)  ,  NLAYER,  NMTRLS, 

1  THK ( 30 ) 


COORDINATE  ARRAYS 

COMMON/COORD/XC  20D) , XD ( 2DD ) , CHL ( 2DD ) , DHL ( 2D0 ) , DPDDC  2DD) , DPDEC  2DD)  , 

1  EHLC2DD) , HC2DD, 3) , NEM ( 2D0 ) , NET ( 20D ) , PHLC2D0) , RHLC2DD) ,SDT(2DD)  , 

2  SHLC20D) , TC20D) , U ( 2DD ) , YHL ( 2DD )  ,  ZHLC2D0) 

COMMON/NSC/A (5DDD) 

NAMED  COMMON 
REAL  MU, MUM 

COMMON  /EQS/  EQSTA ( 6 ) , EQSTCC  6) , EQSTD ( 6 ) , EQSTEC6) , EQSTG ( 6 ) , 

1  EQSTH ( 6 ) , EQSTN ( 6 ) , EQSTS ( 6 ) , EQSTV ( 6 ) , CZQ ( 6 ) , CWQ ( 6 ) , C2 ( 6 ) 

COMMON  /MELT/  EMELT ( 6, 6 ) , GMELT ( 6, 8 ) , SPH ( 6 ) , THERM ( 6,  8 ) 

COMMON  /RHO/  RHO ( 6 ) , RHOS ( 6 ) 

COMMON  /TSR/  TSR ( 6, 3D) , EXMAT ( 6, 20) , TENS ( 6, 3) 

COMMON  /Y/  YD(6) ,YADD(6) , MU ( 6 ) , MUM, YADDM 

COMMON  /IND/  I  EOS ( 6 ) ,  I NDK ( 2D ) , NALPHA, NCMP ( 6 ) , NFR ( 6 ) , NPOR ( 6 ) , 

1  NDS C  6 ) , NPR ( 6 ) , NCON ( 6 ) , NVAR ( 6 ) 

COMMON  /RAD/  SSTOPC  9) , START ( 9 ) , SDURM, SSTOPM, NSPEC, SSJ, JSS,  I  PLOT (4 ) 
1  , XMAX ( 4 ) , XM I N ( 4 ) , YMAX ( 4 ) , YM I N ( 4 ) ,  I  AC  7),  I T I TLE ( 24 ) , NARZ, TARZ 

COMMON/SS/SS ( 5DD ) 

COMMON  /PES/  LVMAX, LVTOT, LVAR ( 20D ) , COM (4000) 

DIMENSION  ACC  1 09) , AADC6, 6,  1 D ) , AA1  C  6, 6,  1 0) , AA2C  6, 6,10), AA3C6, 6,  ID), 

1  EDGE (6, 6,  1 0) , El  ( 1 D9) , RHOC (6,6), TBLC 1 D9) , NOE (6, 6) ,  I  VAR ( 8) , 

2  ATWTC6, 6) , BBDYC 100), PBW ( 6 ) , NAME C 6 ) , E I BB ( 1 OD) 

DIMENSION  DELXC20D) , EPGJC2DD) , PCTC2DD) , CPGC2DD) , TCC20D) , PC20D) , 

1  DIMPMCCC20D) , FRONT (5, 3D ) , XPL ( 20D ) , YPL ( 2DD ) , EABSC2D0) 

DIMENSION  ANGLE ( 3D ) 

EQU I  VALENCE ( A ( 2D 1 ) , AC) ,  ( A ( 31 D ) , AAD ) ,  ( A ( 670) , AA1 ) ,  (AC  1 D3D ) , AA2) , 

1  ( A( 1 39D ) , AA3 ) , ( A( 1 75D) , EDGE) , (A(211D),EI),(A(2219), RHOC) , 

2  ( A( 2255) , TBL ) , ( A( 2364) , NOE) , ( A(240D) , ATWT ) 

EQU I  VALENCE ( DELX, A ) ,  (EPGJ, A(2D1  ) ) ,  (PCT, A (401  ) ) ,  (CPG, A(6D1  ) ) , 

1  ( TC, A ( 8D 1 ) ) , ( P , A ( 1 DD 1 ) ) , (DIMPMCC, A( 1 201 )) , (XPL, A( 14D1 ) ) , 

2  ( YPL, A( 1 6D1 ) ) , ( EABS , A ( 1 801 ) ) 

DATA  BBDY / . D1 ,  . D3,  . D5,  . D7,  . D9,  . 15,  .25,  .35,  .45,  .55,  .65,  .75, 

1 .85, .95, 1 .D5, 1 . 15, 1 .25, 1 .35, 1 .45, 1 .55, 1 .65, 1 .75, 1 .85, 1 .95,2.05, 

22. 15,2.25,2.35,2.45,2.55,2.65,2.75,2.85,2.95,3.05,3. 15,3.25, 
33.35,3.45,3. 55,3.65,3.75, 3.85, 3. 95,4. D5, 4. 15,4.25,4.35,4.45, 
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DEPOS 
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DEPOS 

DEPOS 

DEPOS 
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PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 
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PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

COORDCOM 

COORDCOM 

COORDCOM 

COORDCOM 

NSCCOM 

EQSTCOM 

EQSTCOM 

EQSTCOM 

EQSTCOM 

EQSTCOM 

EQSTCOM 

EQSTCOM 

EQSTCOM 

I NDCOM 

I NDCOM 

RADCOM 

RADCOM 

SSCOM 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 

DEPOS 


1 

1  1 
12 

13 

14 
1  5 
16 
17 
1  8 
19 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1  1 
1  2 
1  3 

14 

15 
1  6 
1  7 
1  8 
1  9 
2D 

2 

3 

4 

5 
2 
2 

3 

4 

5 

6 

7 

8 
9 
2 
3 
2 
3 
2 

27 

28 
29 
3D 

31 

32 

33 

34 

35 

36 

37 

38 

39 
4D 

41 

42 

43 

44 

45 

46 
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c 

2 

3 

4 

5 

10 
1  1 
14 


1  5 

54 

55 

56 

57 
70 

72 

73 

74 
75 

76 

77 
60 
81 

82 

89 

92 

93 
C 

240 
C  *  * 
C 

250 


255 


SUBROUTINE  DEPOS  (Continued) 


44. 55.4 

55 . 75. 5 
68.3,8. 
716. 5, 1 

DATA  E 
13.312E 
057E 
544E 
067E 
1  83E 
998E 
657E 
279E 
350E 
021  E 
380E 
730E 
092E 


27 
31 
42 
52 
61 
71 
81 
99 
.  1 
.  4 
.  1 
.  1 


.  65,  4 
.  85,  5 
5,  8. 7 
7.5,1 
IBB/4 
-4,8. 
-3,  8. 
-2,  1  . 
-2,  2. 
-2,  2. 
-2,  1  . 
-2,  1  . 
-2,  1  . 
-3,8. 
-2,9. 
-3,  3. 
-3,  1  . 
-4,4. 


.  75,  4 

.  95,  6 

,8.9, 

8.5,1 

.  076E 

555E- 

330E 

644E- 

106E- 

172E- 

956E- 

603E- 

227E- 

910E- 

1  1  0E- 

850E- 

500E- 

852E 


. 85,4 . 95,5. 

.  1  0,  6. 3,  6. 5 
9.  1 , 9. 3,  9. 5 
9. 5, 20. 5, 5* 
-7, 2. 829E-6 
4,1. 582E-3, 
3, 9, 595E-3, 
2, 1 . 736E-2, 
2, 2. 138E-2, 
2, 2. 155E-2, 
2, 1 . 910E-2, 
2, 1 . 549E-2, 
2,1.1 76E-2, 
3,8. 470E -3, 
3,8. 100E-3, 
3,3. 380E-3, 
3,5. 008E-3, 
5,2. 131E-5, 


05, 5. 15 
,6.7,6. 
,9. 7,9. 
0.0/ 

, 7. 604E 
2.475E- 
085E- 
819E- 
1  63E- 
1  32E- 
863E- 
495E- 
125E- 
572E- 
200E- 
960E- 
425E- 
269E- 


, 5. 25, 5. 35, 5. 45, 5. 55,  5. 65, 

9,  7.  1 , 7. 3,  7. 5,  7. 7, 7. 9,  8.  1  , 

9, 10. 5, 11. 5, 12. 5, 13. 5, 14. 5, 15. 5, 


"6,  1 
3,  3. 
2,  1  . 
2,  1  . 
2,2. 
2,2. 
2,  1  . 
2,  1  . 
2,  1  . 
2,  1  . 
3,  6. 
3,  2. 
3,  1  . 
6,3. 


.  466E 
498E- 
206E- 
693E- 
176E- 
105E- 
814E- 
440E- 
076E- 
417E- 
370E- 
510E- 
147E- 
996E- 


-5, 2. 393E-5, 
3,4. 622E-3, 5 
2, 1 . 326E-2, 1 
2, 1 . 960E-2, 2 
2, 2. 187E-2, 2 
2, 2. 073E-2, 2 
2, 1 . 763E-2, 1 
2, 1 . 387E-2, 1 
2, 1 . 027E-2 , 9 
2, 1 . 274E-2, 1 
3, 5. 640E-3, 4 
3, 2. 350E-3, 1 
3, 5. 322E-4, 2 
6, 2. 960E-6, 5 


. 81 8E-3, 
. 438E-2, 
. 01 7E-2, 
. 188E-2, 
. 037E-2 , 
. 71  IE-2, 
. 332E-2, 
. 800E-3, 
. 142E-2, 
. 970E-3, 
. 980E-3, 
.429E-4, 
*0.  / 


FORMAT ( 1 H  +  , 79X, 5H  IND=A2,5H,  IN=I2,9H  -DEPOS-  ) 

FORMAT ( 1 H+, 1 03X, *  ANGLE  FROM  NORMAL ( DEG) * ) 

FORMAT ( 1  H  +  ,  1 03X , *,  ,  , CAL/CM2, SEC, SEC* ) 

FORMAT (  1  H  + , 1 03X , *,CM,ERG/G*) 

FORMAT ( A1 , A9, A5, A2,  I  3, 3( A1 0, El  0 . 3) ) 

FORMAT ( 4 ( A1 0 ,  1  PEI  0.3) ) 

FORMAT  ( *  1 #,  1 0A1 0//3X, * J*, 9X, *X*, 9X, *X*, 2(5X,  * DEPOS* ) , 

1  3X , *PCT  TR . * , 5X, *TEMP . *, 4X, * PRESS. *, 3X, *  I MPULSE* , 5X , * MATER  I AL*4X , 
2*C0ND*6X , *J*, 8X , *DX*2X, ^ABSORBED*/ 1  OX , *INCH*8X, *CM*3X, *ERGS/GM*,4X 
3  , *  CAL/GM# ,  14X, *  DEG .  C*, 6X, *KBAR*, 5X, *KTAPS*, 36X, *CM*3X, * CAL/ CM2* ) 
FORMAT (  14, 2F1 0. 6,  1 P2E1 0. 3, FI  0. 3,  1 P3E1  0. 3,  3X, A9, 3X, 3R2, 2X,  I  5, 1  PEI  0. 
1  3,  FI  0 . 3 ) 

FORMAT  (A10,  MO,  A7,  A3,  1P5E10.3) 

FORMAT (A1 , A9,A8, 12, A10,F10.7) 

FORMAT ( A1 , A9, 2A1 0,  II 0, A1 0, FI  0 . 3 ) 

FORMAT ( 1 P8E 1 0 . 3 ) 

FORMAT ( *  0*8X, *Y I ELD=  *  1  PE 1 0 . 3 , *  SOUND  SP= *  1  PE  1 0 . 3 , *  DENS  I TY  =  * 

1  1  PEI  0.3,*  TENS  STR  =  * 1  PEI  0.3,*  INTERFACE  STRENGTH= *  1  PE 1 0 . 3/ ) 

FORMATC 1 0X,  *DEPOS  -  CONST.  DENSITIES  ( G/CM3) ,  RHOC  =*1P6E10.3) 
FORMAT ( 1  OX, *DEPOS  -  ESUM  =*1PE10.3,*  CAL/CM2* ) 

FORMAT ( *  TOTAL  ENERGY  ABSORBED  IS*1PE12.3,*  CAL/CM2* ) 

FORMAT  (A1 , A9, 2A10,  I  10, 4A1 0) 

FORMAT ( *  TOTAL  ENERGY  ABSORBED  IS*1PE12.3,*  CAL/CM*) 

FORMATC*  TOTAL  ENERGY  ABSORBED  IS*1PE12.3,*  CAL*) 

FORMAT ( A7, 1P4E13.5) 

FORMAT ( 7X, 1P4E13. 5) 

FORMAT  (*  ERROR  IN  MCCLOSKEY  INTEGRAL  FOR  LAYER* 13,*,  X(J+1)=* 

1  1  PE 10.3, *  DID  NOT  LIE  BETWEEN  *1PE10.3,*  AND  *1PE10.3) 

FORMATC 13X, E12.5,1X,E12.5,1X,E12.5,1X,E12.5) 

FORMATC 4 (2A5, 1PE10. 3) ) 

FORMATC A1 , A9, 2A1 0,  1  PE 1 0 . 3 , A 1 0,  1  PE  1 0 . 3 ) 

GO  TO  (250,400,700)  NPART 

ENTRY  FOR  READING  MATERIAL  ABSORPTION  PARAMETERS 

CONTINUE 
N CONST  =  NCON  CM) 

NNOE= 1  OH  X-RAY  ABS 
I DD= 1 H  $  I N5=5 
DO  260  NC= 1 , NCONST 

READ  ( I N, 550 A 1 , NAME ( NC ) , A2,  I  TAPE, A3, PBWC NC) 

WRITE  ( 6 , 55 ) A 1  , NAME ( NC ) , A2 ,  I  TAPE, A3, PBW C NC) 

WRITE  (6,2)  IDD, IN 
I NL= I N 

IF  (I  TAPE  .EQ.  0)  GO  TO  255 
I NL= I  TAPE 

CALL  REDR ( NAME ( NC) , NNOE, INL,2) 

READ  ( I NL, 56 ) A 1 , NAME ( NC ) , A2 , A3 , NOE  CM, NC) , A4, ATWTCM, NC) 

WRITE  (6, 56)A1 , NAME (NC) , A2, A3, NOE ( M, NC) ,A4, ATWTCM, NC) 

WRITE  (6,2)  IDD, I NL 

NOED=NOE(M, NC)  $  NOE1=N0ED+1 

READ  ( INL, 89)  (EDGE  CM, NC, ND ) , ND=1 , NOED) 

FN=7H  EDGE 

WRITE  (  6, 80)FN, (EDGECM, NC, ND) , ND=1 , NOED) 

WRITE  (6,2)  IDD, INL 

READ  ( INL, 89)  (AAOCM, NC, ND) , AA1 CM, NC, ND ) , AA2CM, NC, ND) . 


DEPOS 

47 

DEPOS 

48 

DEPOS 

49 

DEPOS 

50 

DEPOS 

51 

DEPOS 

52 

DEPOS 

53 

DEPOS 

54 

DEPOS 

55 

DEPOS 

56 

DEPOS 

57 

DEPOS 

58 

DEPOS 

59 

DEPOS 

60 

DEPOS 

61 

DEPOS 

62 

DEPOS 

63 

DEPOS 

64 

DEPOS 

65 

DEPOS 

66 

DEPOS 

67 

DEPOS 

68 

DEPOS 

69 

DEPOS 

70 

DEPOS 

71 

DEPOS 

72 

DEPOS 

73 

DEPOS 

74 

DEPOS 

75 

DEPOS 

76 

DEPOS 

77 

DEPOS 

78 

DEPOS 

79 

DEPOS 

80 

DEPOS 

81 

DEPOS 

82 

DEPOS 

83 

DEPOS 

84 

DEPOS 

85 

DEPOS 

86 

DEPOS 

87 

DEPOS 

88 

DEPOS 

89 

DEPOS 

90 

DEPOS 

91 

DEPOS 

92 

DEPOS 

93 

DEPOS 

94 

DEPOS 

95 

DEPOS 

96 

DEPOS 

97 

DEPOS 

98 

DEPOS 

99 

DEPOS 

100 

DEPOS 

1  01 

DEPOS 

1  02 

DEPOS 

1  03 

DEPOS 

104 

DEPOS 

105 

DEPOS 

106 

DEPOS 

1  07 

DEPOS 

1  08 

DEPOS 

1  09 

DEPOS 

1  1  0 

DEPOS 

1  1  1 

DEPOS 

1  1  2 

DEPOS 

1  13 

DEPOS 

1  14 

DEPOS 

1  15 

DEPOS 

1  16 

DEPOS 

1  1  7 

DEPOS 

1  18 

DEPOS 

1  19 

DEPOS 

120 

DEPOS 

1  21 
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SUBROUTINE  DEPOS  (Continued) 


1  AA3 ( M , NC , ND ) , ND=1 , NOED ) 

DEPOS 

122 

FN=7H  C0EFS 

DEPOS 

123 

WRITE (6, 80)  FN, AAO ( M ,  NC , 1  ) , AA 1  ( M , NC ,  1  ),AA2(M,NC,  1  ),AA3(M,NC,  1  ) 

DEPOS 

1  24 

I F  (NOED  . EQ.  1 )  GO  TO  258 

DEPOS 

1  25 

WRITE (6, 81  ) (AAO  CM, NC, ND) , AA1  CM, NC, ND) , AA2(M, NC, ND) , AA3(M, NC, ND) , 

DEPOS 

1  26 

1  ND=2 , NOED ) 

DEPOS 

1  27 

258 

WRITEC6, 2) IDD, I NL 

DEPOS 

1  28 

260 

CONTINUE 

DEPOS 

1  29 

WTOT  = 1  . 

DEPOS 

1  30 

IF  ( NCONST  . EQ .  1  .OR.  PBW(l)  . LT .  1.)  GO  TO  280 

DEPOS 

131 

WTOT  =  0 . 

DEPOS 

1  32 

DO  270  NC=1, NCONST 

DEPOS 

133 

PBW(NC) =PBW(NC) *ATWT(M, NC) 

DEPOS 

1  34 

270 

WTOT  = WTOT+PBW ( NC ) 

DEPOS 

1  35 

280 

DO  290  NC=1, NCONST 

DEPOS 

1  36 

290 

RHOCCM, NC ) =  RHO (M ) *PBW ( NC ) /WTOT 

DEPOS 

137 

IF  (NCONST  .EQ.  1)  RHOC ( M, 1 ) = RHO ( M ) 

DEPOS 

1  38 

WRITE  (6, 72)  ( RHOC ( M , NC) , NC=1 , NCONST) 

DEPOS 

1  39 

RETURN 

DEPOS 

140 

c  *************  *********** 

DEPOS 

141 

c 

ENTRY  FOR  DEPOSITING  RADIATION  IN  THE  SS  ARRAY 

DEPOS 

142 

400 

READ  (5, 54 )  A1 , NSPEC, N2, A2, ( ANGLE (NL) , NL= 1 , 5) 

DEPOS 

143 

WRITE  (6,54)  A1 , NSPEC, N2, A2, ( ANGLE ( NL ) , NL= 1 , 5 ) 

DEPOS 

144 

WRITE  (6,2)  I ND, I N5  $  WRITE  (6,3) 

DEPOS 

145 

IF  ( N2  EQ.  7H  ANGLES  )  GO  TO  402 

DEPOS 

146 

DO  401  NL  =  2, NLAYER 

DEPOS 

147 

401 

ANGLE ( NL ) = ANGLE ( 1 ) 

DEPOS 

148 

GO  TO  403 

DEPOS 

149 

402 

IF  (NLAYER  .LE.  5)  GO  TO  403 

DEPOS 

150 

READ  (5, 57)  (ANGLE (NL) , NL=6, NLAYER) 

DEPOS 

151 

WRITE  (6,57)  (ANGLE(NL) , NL=6, NLAYER) 

DEPOS 

1  52 

WRITE  (6,2)  I ND , I N5  S  WRITE  (6,3) 

DEPOS 

1  53 

403 

DO  404  NL= 1 , NLAYER 

DEPOS 

154 

FRONT (1 , NL) =FR0NT(2, NL ) = FRONT ( 3 , NL ) = FRONT ( 4 , NL ) = FRONT ( 5 , NL) =0. 

DEPOS 

155 

404 

ANGLE ( NL )= COS (ANGLE (NL)/57. 2957795) 

DEPOS 

1  56 

C 

BEGIN  LOOP  OVER  EACH  SPECTRUM 

DEPOS 

1  57 

T0TCAL=O. 

DEPOS 

1  58 

DO  4040  1=1, 500 

DEPOS 

1  59 

4040 

SS( I ) =0. 

DEPOS 

1  60 

DO  485  NS= 1 , NSPEC 

DEPOS 

161 

JF I NNS= JF I N* ( NS - 1 ) 

DEPOS 

1  62 

I  N  =  5 

DEPOS 

163 

I DD=5H 

DEPOS 

1  64 

C 

INDICATOR  IN  COLUMNS  11  THROUGH  15  SHOWS  SPECTRUM  TYPE 

DEPOS 

1  65 

C 

5H  NHNU  =  ARBITRARY  SPECTRUM 

DEPOS 

1  66 

C 

5H  NBB  =  SERIES  OF  BLACK  BODIES  ( NBB  OF  THEM) 

DEPOS 

1  67 

C 

5H  NARB  =  DEPOSITION  FROM  SCATT  PROGRAM 

DEPOS 

1  68 

READ  (5,10)  I ND, SPECNAM, A1 , A2, NHNU, A3, ECAL , A4 , START ( NS ) , A5, 

DEPOS 

1  69 

1  SSTOP(NS) 

DEPOS 

1  70 

WRITE  (6, 1 0) I DD, SPECNAM, A 1 , A2, NHNU, A3, ECAL , A4 , START ( NS ) , A5, 

DEPOS 

171 

1  SSTOP(NS) 

DEPOS 

172 

WRITE  (6,2)  I ND , I N5  S  WRITE  (6,4) 

DEPOS 

1  73 

NARB = NBB = NHNU 

DEPOS 

174 

IF  (IND  .EQ.  IDD)  GO  TO  405 

DEPOS 

1  75 

I  N  =  4 

DEPOS 

1  76 

CALL  REDR(SPECNAM, IDD, IN, 1 ) 

DEPOS 

1  77 

405 

CONTINUE 

DEPOS 

1  78 

SSTOPM= AMAX1 ( SSTOPM, SSTOP ( NS )  ) 

DEPOS 

179 

IF  ( A 1  .EQ.  5H  NARB)  GO  TO  465 

DEPOS 

180 

IF  (A1  .EQ.  5H  NBB  )  GO  TO  420 

DEPOS 

181 

NRAD= 1  $  TEMP= 1 . 

DEPOS 

182 

C 

ARBITRARY  SPECTRUM  INPUT 

DEPOS 

183 

READ  ( I N, 75) A1 , SPECNAM, A2, A3, NHNU,  ( I  VAR ( I  ) ,  I =1 ,4) 

DEPOS 

184 

WRITE  (6, 75) A1 , SPECNAM, A2, A3, NHNU, ( IVAR( I ) , I =1 ,4 ) 

DEPOS 

1  85 

WRITE  (6,2)  IDD, IN 

DEPOS 

1  86 

IF  ( I  VAR ( 1  )  .NE.  IDD)  GO  TO  412 

DEPOS 

1  87 

DO  41 0  NH= 1 , NHNU 

DEPOS 

1  88 

READ  (IN, 11)  A1 , TBL(NH) , A2, El (NH) , A3 

DEPOS 

1  89 

410 

WRITE  (6,11)  A1 , TBL(NH) , A2, El (NH) , A3 

DEPOS 

1  90 

WRITE  (6,2)  IDD, IN 

DEPOS 

191 

GO  TO  415 

DEPOS 

192 

412 

READ  (IN,  I  VAR)  (TBL(NH) , El  (NH) , NH=1  , NHNU) 

DEPOS 

1  93 

WRITE  (6,  I  VAR) (TBL(NH) , El (NH) , NH=1 , NHNU) 

DEPOS 

194 

WRITE  (6, 2)  IDD, IN 

DEPOS 

195 

ESUM  =  0. 

DEPOS 

1  96 

212 


SUBROUTINE  DEPOS  (Continued) 


DO  413  NH  =  1, NHNU 

DEPOS 

197 

413 

ESUM  =  ESUM+E I ( NH ) 

DEPOS 

1  98 

415 

DO  417  NH= 1 , NHNU 

DEPOS 

1  99 

417 

EI(NH)  =  El ( NH ) * ECAL/ESUM 

DEPOS 

200 

NR  = 1  $  GO  TO  430 

DEPOS 

201 

C 

BLACK  BODY  INPUT 

DEPOS 

202 

420 

NRAD  =  NBB  $  NHNU  =  95 

DEPOS 

203 

NR=  1 

DEPOS 

204 

4  24 

READ  (IN,  93 )  A1 , SPECNAM, A2, A3, TEMP,  A4  t ECAL 

DEPOS 

205 

WRITE  (6,93)  A1 , SPECNAM, A2, A3, TEMP, A4 , ECAL 

DEPOS 

206 

WRITE  (6,2)  IDD, IN 

DEPOS 

207 

DO  428  NH= 1 , NHNU 

DEPOS 

208 

TBL ( NH ) =  BBDY ( NH ) 

DEPOS 

209 

428 

El ( NH ) =ECAL*E I BB ( NH ) 

DEPOS 

21  0 

430 

ESUM=0 . 

DEPOS 

21  1 

DO  431  NH= 1 , NHNU 

DEPOS 

212 

431 

ESUM  =  ESUM+E I (NH) 

DEPOS 

21  3 

WRITE  (6,73)  ESUM 

DEPOS 

214 

C 

DEPOS 

215 

C 

COMPUTATION  OF  ABSORPTION  COEFFICIENT  -  AC 

DEPOS 

216 

PERCNT  =  0 . 005*  ECAL 

DEPOS 

217 

X(1 ) =0 . 

DEPOS 

218 

XBNDM=0 . 

DEPOS 

219 

DX2=50. 

DEPOS 

220 

JBEG= 1 

DEPOS 

221 

DO  460  L= 1 , NLAYER 

DEPOS 

222 

M= JMAT ( L ) 

DEPOS 

223 

DO  432  1=1,4 

DEPOS 

224 

432 

FRONT ( I , L) =0. 

DEPOS 

225 

DO  433  NH= 1 , 1 09 

DEPOS 

226 

433 

AC(NH) =0. 

DEPOS 

227 

NCONST  =  NCON ( M ) 

DEPOS 

228 

DO  445  NC= 1 , NCONST 

DEPOS 

229 

NEDG= 1 

DEPOS 

230 

DO  445  NH= 1 , NHNU 

DEPOS 

231 

ALNE= ALOG ( TBL ( NH ) *TEMP ) 

DEPOS 

232 

IF  ( TBL ( NH ) *  TEMP  . GE .  1.)  GO  TO  438 

DEPOS 

233 

AC ( NH ) = AC ( NH ) +RHOC  CM, NC) *EXP (A AO ( M , NC,  1  ) +ALNE* AA1 (M,NC, 1 ) ) 

DEPOS 

234 

1  * ( C . 602252/ ATWT (M , NC) ) /ANGLE ( L ) 

DEPOS 

235 

GO  TO  444 

DEPOS 

236 

438 

IF  ( NEDG  .GE.  NOE(M,NC))  GO  TO  440 

DEPOS 

237 

IF  (EDGE(M, NC, NEDG+1 )  . GT .  TBL ( NH ) *TEMP )  GO 

TO  440 

DEPOS 

238 

NEDG=NEDG+1  $  GO  TO  438 

DEPOS 

239 

440 

AC ( NH ) =AC ( NH ) +RHOC  CM, NC) *EXP(AAO(M, NC, NEDG) +ALNE* ( AA1 (M, NC, NEDG) 

DEPOS 

240 

1  +ALNE* ( AA2 (M, NC, NEDG) +ALNE*AA3(M, NC, NEDG) ) ) ) * ( 0 . 602252/ ATWT ( M, NC 

DEPOS 

241 

2  ) ) /ANGLE ( L ) 

DEPOS 

24  2 

444 

CONTINUE 

DEPOS 

243 

445 

CONTINUE 

DEPOS 

244 

C 

DEPOS 

24  5 

C 

DISTRIBUTE  ENERGY  INTO  CELLS 

DEPOS 

246 

XBNDM=XBNDM+THK ( L) 

DEPOS 

247 

JBNDM= JBND ( L ) -1 

DEPOS 

248 

J= JBEG 

DEPOS 

249 

446 

IF  (J  .GT.  JBEG+1  .AND.  XBNDM  . EQ .  0.)  GO  TO 

447 

DEPOS 

250 

DEP=0 . 

DEPOS 

251 

DO  4461  NH= 1 , NHNU 

DEPOS 

252 

4461 

DEP  =  DEP+AC ( NH ) *  E I  (NH) 

DEPOS 

253 

IF  (J  .EQ.  JBEG)  GO  TO  4462 

DEPOS 

254 

FRONT (4 , L)=DEP/RH0(M)+FR0NT(4J  L) 

DEPOS 

255 

GO  TO  447 

DEPOS 

256 

4462 

FRONT (1 , L ) =DEP/RHO ( M ) +FRONT ( 1  ,L) 

DEPOS 

257 

FRONT (3, L ) =FRONT ( 1 , L) *RHO(M) *EQSTG(M) *4 . 1 86E 

-2 

DEPOS 

258 

IF  (SPH(M)  .GT.  0.)  FRONT ( 2, L ) = FRONT (1,L)/SPH(M)+22.2 

DEPOS 

259 

DX1 =DX2 

DEPOS 

260 

447 

IF  (XBNDM  .GT.  0.)  GO  TO  4481 

DEPOS 

261 

DX=X( J+1 ) -X ( J ) 

DEPOS 

262 

GO  TO  449 

DEPOS 

263 

4481 

DX=ABS ( PERCNT/ DEP ) 

DEPOS 

264 

IF  (DX  .GT.  1 . 05#DX1 )  DX=1.05*DX1 

DEPOS 

265 

IF  (XBNDM  .GT.  X(J)+  DX)  GO  TO  448 

DEPOS 

266 

DX2=2 . *DX 

DEPOS 

267 

DX=XBNDM-X ( J ) 

DEPOS 

268 

X ( J+2 )  =  XBNDM 

DEPOS 

269 

JBND ( L ) =  J+ 1 

DEPOS 

270 

JBNDM= J 

DEPOS 

271 
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SUBROUTINE  DEPOS  (Continued) 


448 

X( J+1 )=X( J)+DX 

DEPOS 

272 

DX1 =DX 

DEPOS 

273 

449 

ESUM  =  0 . 

DEPOS 

274 

DO  450  NH= 1 , NHNU 

DEPOS 

275 

IF  (EI(NH)  .LT.  1.E-20)  GO  TO  450 

DEPOS 

276 

EIZ=EI (NH)#(1 . -EXP ( - 1 . *AC(NH)*DX) ) 

DEPOS 

277 

El ( NH ) =  E I  (NH)-EIZ 

DEPOS 

278 

ESUM  =  E I Z+ESUM 

DEPOS 

279 

450 

CONTINUE 

DEPOS 

280 

SS( JFI NNS+J)=ESUM*4. 1  86E7/RH0  ( M ) /DX/ ( SSTOP  (  NS )  -START  (NS)  )  *  ANGLE  (L) 

DEPOS 

281 

1  +SS( JFINNS+J) 

DEPOS 

282 

TOTCAL  =  ESUM+TOTCAL 

DEPOS 

283 

IF  (J  .EQ.  JBNDM)  GO  TO  460 

DEPOS 

284 

J  =  J  +  1 

DEPOS 

285 

GO  TO  446 

DEPOS 

286 

460 

JBEG  =  JBND ( L )  + 1 

DEPOS 

287 

IF  (JFIN  .GT,  0)  GO  TO  462 

DEPOS 

288 

JF I N= JBEG 

DEPOS 

289 

X( JFIN)=X( J+1 ) 

DEPOS 

290 

462 

J I N I T= 1 

DEPOS 

291 

NR=NR+ 1 

DEPOS 

292 

IF  (NR-NRAD)  424,424,485 

DEPOS 

293 

C 

DEPOSITION  FROM  SCATT  PROGRAM 

DEPOS 

294 

465 

ETOT  =  0 . 

DEPOS 

295 

DO  483  L= 1 , NLAYER 

DEPOS 

296 

M  =  JMAT ( L ) 

DEPOS 

297 

RATIO  =  1 . 

DEPOS 

298 

IF  (NARB  .GE.  0)  GO  TO  466 

DEPOS 

299 

READ  (5,11)  A1 , RHOOLD 

DEPOS 

300 

WRITE  (6,11)  A1 , RHOOLD 

DEPOS 

301 

RATIO  =  RHOOLD/RHO ( M ) 

DEPOS 

302 

466 

CONTINUE 

DEPOS 

303 

READ  (IN, 75)  A1 , SPECNAM, A2, A3, NPOI NT,  (IVAR(I),I=1 

,4) 

DEPOS 

304 

WRITE  (6,75)  A1  , SPECNAM, A2, A3, NPOINT,  ( I  VAR ( I ) ,  I  =  1 

j  4 ) 

DEPOS 

305 

WRITE  (6, 2)  IDD, IN 

DEPOS 

306 

IF  (NPOINT  .EQ.  0)  GO  TO  483 

DEPOS 

307 

IF  ( I  VAR ( 1  )  .NE.  IDD)  GO  TO  475 

DEPOS 

308 

DO  470  NP= 1 , NPOINT 

DEPOS 

309 

READ  (IN, 92)  A 1 , A2, TBL ( NP ) , A3 , A4 , El ( NP ) 

DEPOS 

310 

470 

WRITE  (6,92)  A1 , A2, TBL(NP) , A3, A4, El (NP) 

DEPOS 

31  1 

WRITE  (6,2)  IDD, IN  $  WRITE  (6,5) 

DEPOS 

312 

GO  TO  476 

DEPOS 

313 

475 

READ  (IN,  I  VAR) (TBL(NP) , El (NP) , NP=1  ,  NPOINT) 

DEPOS 

314 

WRITE  (6,  I  VAR) (TBL(NP),EI (NP),NP=1 , NPOI NT) 

DEPOS 

31  5 

WRITE  (6,2)  IDD, IN  $  WRITE  (6,5) 

DEPOS 

316 

476 

CONTINUE 

DEPOS 

317 

FRONT ( 1 , L )  =  E I ( 1 )  *  ECAL  +  FRONT ( 1 , L ) 

DEPOS 

318 

IF  (SPH(M)  .GT.  0.)  FRONT (  2 ,  L )  =  FRONT ( 1 , L ) /SPH ( M ) +22 . 2 

DEPOS 

319 

FRONT (3, L ) =FR0NT ( 1 , L ) *RHO ( M ) *EQSTG ( M ) *4 . 1 86E-2 

DEPOS 

320 

J=1 

DEPOS 

321 

IF  (L  . GT.  1 )  J  =  JBND ( L- 1  )+1 

DEPOS 

322 

IF  ( ABS ( TBL (1 ) -X ( J ) )  .LT.  1.E-10  .AND.  RATIO  . EQ .  1.) 

GO  TO  478 

DEPOS 

323 

DX  =  X( J) -TBL ( 1 ) 

DEPOS 

324 

DO  477  1=1,  NPOINT 

DEPOS 

325 

477 

TBL ( I ) = ( TBL ( I ) +DX-X ( J ) ) *RAT I 0+X ( J ) 

DEPOS 

326 

478 

CONTINUE 

DEPOS 

327 

XJP1 =X( J+1 ) 

DEPOS 

328 

DO  479  1=1, NPOINT 

DEPOS 

329 

IF  ( TBL ( I )  .GT.  XJP1-1.E-8)  GO  TO  480 

9/12/79 

1 

479 

CONTINUE 

DEPOS 

331 

PRINT  82, L, XJP 1 , TBL ( 1  ) , TBL ( NPO I  NT ) 

DEPOS 

332 

GO  TO  481 

DEPOS 

333 

480 

I =M I  NO ( I , NPO I  NT- 1  ) 

DEPOS 

334 

XI =TBL ( I  - 1  )  $  X2  =  TBL( I )  $  X3  =  TBL(I+1) 

DEPOS 

335 

Z1 = ( XJP1 -X3 ) / ( X2-X1 ) *(XJP1 -X2)/(X3-X1 ) 

DEPOS 

336 

Z2= ( X JP 1 -XI )/(X3-X2)*(XJP1 -X3 ) / ( XI -X2) 

DEPOS 

337 

Z3= ( XJP1 -X2 ) / ( X3-X1 )*(XJP1 -XI ) / ( X3-X2 ) 

DEPOS 

338 

FR0NT(4, L) =ECAL*EI (1 )**Z1*EI (2)**Z2*EI (3)**Z3  +  FRONT ( 4 , L ) 

DEPOS 

339 

481 

CONTINUE 

DEPOS 

340 

CALL  SCATTO ( TBL, E I , ECAL, NPOINT, NS, L, ESUM) 

DEPOS 

341 

ET0T=ESUM*RHO(M)+ET0T 

DEPOS 

342 

483 

CONTINUE 

DEPOS 

343 

RATIO  =  ECAL 

DEPOS 

344 

IF  ( I ABS ( NARB )  . EQ .  1)  RATIO  =  ECAL/ETOT 

DEPOS 

345 

DO  484  J=1 , JFIN 

DEPOS 

346 

214 


SUBROUTINE  DEPOS  (Continued) 


484 

SS( JFI NNS+J) =SS( JFI NNS+J) * RAT  10 

DEPOS 

347 

TOTCAL=TOTCAL+RATIO*ETOT 

DEPOS 

348 

C 

END  OF  NSPEC  LOOP 

DEPOS 

349 

485 

CONTINUE 

DEPOS 

350 

500 

RETURN 

DEPOS 

351 

c  a##*#*###***# 

##########* 

DEPOS 

352 

c 

ENTRY  FOR  PRINTING  DEPOSITION  EDIT 

DEPOS 

353 

700 

WRITE  (6, 14) (DISCPTC I ) , 1=1 , 10) 

DEPOS 

354 

JBEG= 1 

DEPOS 

355 

SUMCAL=0 . 

DEPOS 

356 

DO  708  L= 1 . NLAYER 

DEPOS 

357 

C**FI ND  IMPULSE  IN  EACH  LAYER 

DEPOS 

358 

ZLAGR=0 , 

DEPOS 

359 

M= JMAT ( L ) 

DEPOS 

360 

JBNDM= JBND ( L ) 

DEPOS 

361 

EQE=  EQSTEC  M )  $  EQM  =  EMELT ( Mi 1  ) 

DEPOS 

362 

DZLAST  =  0 . 

DEPOS 

363 

DO  707  J=JBEGjJBNDM 

DEPOS 

364 

DELX ( J ) =X ( J+1 ) -X( J) 

DEPOS 

365 

DZ  =  ZHL ( J )  $  ZLAGR= ( DZLAST  +DZ ) /2 . +ZLAGR 

DEPOS 

366 

EPG=0. 

DEPOS 

367 

IF  (J  .LT.  JBNDM )  GO  TO  701 

DEPOS 

368 

XRAT  = ( X ( J ) -X( J-1 ) )/(X( J) -X( J-2) ) 

DEPOS 

369 

CPG ( J ) =CPG ( J - 1 )+(CPG( J-1 ) -CPG( J-2) ) *XRAT 

DEPOS 

370 

PCT( J) =PCT( J-1 ) 

DEPOS 

371 

TC ( J ) =  TC ( J - 1 ) + (  TC (J-1 ) -  TC( J-2) ) *XRAT 

DEPOS 

372 

P(J)=  PCJ-1 )+(  P(J-1)-  P(J-2))*XRAT 

DEPOS 

373 

EABSC J)=EABS( J-1 )+(EABS(J-1 )-EABS(J-2) )*XRAT 

DEPOS 

374 

EPG J ( J ) =0 .  S  D I MPMCC ( J ) 3  D I MPMCC ( J - 1 )  $ 

GO 

TO 

707 

DEPOS 

375 

701 

CONTINUE 

DEPOS 

376 

DO  702  NS= 1 , NSPEC 

DEPOS 

377 

JF  =  JF I  N#  ( NS- 1  )+J 

DEPOS 

378 

702 

EPG=SS ( JF) * ( SSTOP ( NS ) -START (NS) )+EPG 

DEPOS 

379 

C 

TEST  FOR  SETTING  JSTAR 

DEPOS 

380 

IF  ( EPG*EQSTG ( M )  .GT.  1.E7)  JSTAR=J 

DEPOS 

381 

C 

STORE  ENERGY  (ERGS/GM),  CALORIES  AND 

SUM 

OF 

CALORIES 

IN  - 

DEPOS 

382 

EPG J ( J ) =  EPG 

DEPOS 

383 

CPG ( J ) =EPG/4 . 186E7 

DEPOS 

384 

SUMCAL=SUMCAL+CPG ( J ) *ZHL ( J ) /ANGLE ( L ) 

DEPOS 

385 

PCT ( J ) = 1 00 . *(1 . -SUMCAL/TOTCAL) 

DEPOS 

386 

EABSC J) =SUMCAL 

DEPOS 

387 

TC(J)=0.  $  I F (SPH ( M)  .GT.  0.)  TC( J ) =CPG ( J ) /SPH (M) +22 . 2 

DEPOS 

388 

I  HI  =H(  J  j  1  )  $ 

DEPOS 

389 

DH  =  DOLD  =  DHL ( J )  $  EH  =  EHL ( J ) +EPG  $  E0LD  =  0. 

DEPOS 

390 

CALL  HSTRESS 

DEPOS 

391 

P(J)=PHL( J)*1 .E-9 

DEPOS 

392 

H ( J  j 1 )  =  I H 1  $  H ( J  j  3 )  =  I H3 

DEPOS 

393 

PHL( J)=SHL( J) =RHL( J) =0. 

DEPOS 

394 

7031 

IF  ( EQM  . EQ.  0. )  GO  TO  707 

DEPOS 

395 

D I MPMCC ( J ) =  D I MPMCC (J-1 ) 

DEPOS 

396 

IF  (EPG  .LT.  EQM)  GO  TO  707 

DEPOS 

397 

IF  (J  .GT.  JBEG  .OR.  J  . EQ .  JBNDM- 1)  GO  TO  706 

DEPOS 

398 

IF  C FRONT (  1  ,  L ) * FRONT ( 4,  L )  . EQ .  0.)  GO  TO  706 

DEPOS 

399 

C 

SPECIAL  INTEGRATION  FOR  FIRST  CELL  OF  A  LAYER 

TO 

OBTAIN 

DEPOS 

400 

C 

MCCLOSKEY  INTEGRAL 

DEPOS 

401 

IF  ( FRONT ( 1 . L )  .LT.  CPG(J)  .OR.  CPG(J)  . LT .  FRONT ( 4 , 

L) )  GO  TO 

706 

DEPOS 

402 

EQ  =  FRONT ( 1 j  L ) *4 . 1 86E7  S  EA  =  FRONT ( 4 , L ) *4 . 1 86E7 

DEPOS 

403 

ENN  =  ( EO - EA ) / ( EPG - EA ) - 1 .  $  NAB=Ml N1 ( 1 00 . , 2. 

*  EO/EA  +  1  .  ) 

DEPOS 

4  04 

HI =ZLAGR+DZ/2.  $  ZL=ZLAGR-DZ/2 . 

DEPOS 

405 

VOLD  =  ZL* (EO-EQM*  C 1 . +ALOG ( EO/EQM) ) ) 

DEPOS 

406 

DZL=DZ/NAB  $  EMSUM=0. 

DEPOS 

407 

DO  704  1=1. NAB 

DEPOS 

408 

ZL=ZL+DZL  $  EHH=EA+ ( EO-EA )  #  ( (HI -ZL) /DZ ) * *ENN 

DEPOS 

409 

IF  CEHH  .LT.  EQM)  GO  TO  705 

DEPOS 

410 

VNEW  =  ZL* ( EHH-EQM* ( 1 . +ALOGC  EHH/EQM) ) ) 

DEPOS 

41  1 

EMSUM=0. 5*DZL* (VOLD+VNEW)  +  EMSUM 

DEPOS 

412 

704 

VOLD=VNEW 

DEPOS 

413 

705 

D I MPMCC  C  J ) =EMSUM  +  DIMPMCCCJ) 

DEPOS 

414 

GO  TO  707 

DEPOS 

415 

706 

DIMPMCCCJ) =D I MPMCC ( J ) +ZLAGR* ( EPG -EQM* ( 1 . +ALOG ( EPG/EQM ) ) ) *DZ 

DEPOS 

416 

707 

DZLAST  =  DZ 

DEPOS 

417 

IF  (NPOR(M)  .NE.  0)  FRONT ( 3 , L ) =0 . 

DEPOS 

418 

JBEG= JBNDM+ 1 

DEPOS 

419 

708 

CONTINUE 

DEPOS 

420 

COEF  = 1  . 2#SQRT ( 2 .  ) 

DEPOS 

421 

215 


SUBROUTINE  DEPOS  (Continued) 


DO  709  J=1 , JFIN 

DEPOS 

422 

709 

D I MPMCC ( J )  =  CO EF* SORT ( D I MPMCC ( J ) )*1  . OE-3 

DEPOS 

423 

FPCT  = 1 00 . 

DEPOS 

424 

JJ  =  0 

DEPOS 

425 

FEPQ=  FRONT ( 1 , 1 )*4. 1 86E7 

DEPOS 

426 

WRITE  (  6 ,  15)  J  J ,  X  (  1  )  ,  X  (  1  )  ,  FEPG  ,FR0NT(1,1), 

FPCT, FRONT ( 2,  1  )  , 

DEPOS 

427 

1  FRONT ( 3 ,  1 ),X(1 ) j  MATL ( 1 , \  ) 

DEPOS 

428 

L  =  K=  J 1 = 1  $  M  =  JMAT ( L ) 

DEPOS 

429 

710 

J2  =  MIN0( JFIN-1  , 50*K j  JBND ( L ) ) 

DEPOS 

430 

DO  712  J=J1 , J2 

DEPOS 

431 

XINCH=X(J)/2. 54 

DEPOS 

432 

WRITE  (6,15)  J , X I NCH, X( J ) , EPGJ ( J ) , CPG( J),PCT(J)jTC(J) 

)P(J)) 

DEPOS 

433 

1  D I MPMCC ( J ) , MATL (M, 1 ), (H(J, I ), I = 1 , 3 ) , J , DELX ( J ) , EABS ( J ) 

DEPOS 

434 

712 

CONTINUE 

DEPOS 

435 

IF  (J2  . EQ .  JFIN-1)  GO  TO  740 

DEPOS 

436 

J1 =  J2  +  1 

DEPOS 

437 

IF  ( J2  .NE.  50*K )  GO  TO  718 

DEPOS 

438 

K=K+ 1  $  WRITE  (6, 14) (DISCPT( I ) , I =1 , 10) 

DEPOS 

439 

71  8 

IF  ( J2  .NE,  JBND ( L ) )  GO  TO  710 

DEPOS 

440 

WRITE  (6,70)  YHL(J2)jCHL(J2)jDHL(J2)jT(J2-1 ) 

, T( J2) 

DEPOS 

441 

L  =  L+ 1  $  M  =  JMAT ( L ) 

DEPOS 

442 

FEPG=FRONT  (  1  , L) *4 , 1  86E7 

DEPOS 

443 

X I NCH=X ( J 1 ) / 2 . 54 

DEPOS 

444 

WRITE  (6,15)  JJ, XINCH, X(J1 ) , FEPG, FRONT ( 1 , L ) 

, PCT ( J2 ) , FRONT ( 2, L) , 

DEPOS 

445 

1  FRONT ( 3, L ) , D I MPMCC ( J2 ) , MATL ( M , 1 ) 

DEPOS 

446 

GO  TO  710 

DEPOS 

447 

740 

WRITE (6, 70)  YHL ( J2 ) , CHL( J2) , DHL ( J2 ) , T( J2-1  )  , 

T  ( J2 ) 

DEPOS 

448 

GO  TO  (742,743,744)  NALPHA 

DEPOS 

449 

742 

PRINT  74 , SUMCAL 

DEPOS 

450 

GO  TO  746 

DEPOS 

451 

743 

SUMCAL=3 , 1 4 1 59*SUMCAL 

DEPOS 

452 

PRINT  76, SUMCAL 

DEPOS 

453 

GO  TO  746 

DEPOS 

454 

744 

SUMCAL=4. 1 8879*SUMCAL 

DEPOS 

455 

PRINT  77, SUMCAL 

DEPOS 

456 

746 

CONTINUE 

DEPOS 

457 

IF  ( IPLOT( 1 )+IPL0T(2)+IPL0T(3)+IPL0T(4)  , EQ . 

0)  GO  TO 

780 

DEPOS 

458 

c  ***************** 

**************** 

DEPOS 

459 

c 

GRAPHS  OF  DEPOSITED  ENERGY 

DEPOS 

460 

JEND= JF I N - 1  $  L= 1  S  JJ=1$  XPL (1 ) =X ( 1 ) 

DEPOS 

461 

DO  754  J=1 , JEND 

DEPOS 

462 

JJ=JJ+1 

DEPOS 

463 

IF  (J  .EQ.  JBND  CL))  GO  TO  752 

DEPOS 

464 

XPL(JJ) =0. 5*(X(J)+X(J+1  ) ) 

DEPOS 

465 

GO  TO  754 

DEPOS 

466 

752 

XPL ( J J ) =X ( J ) 

DEPOS 

467 

IF  (J  .EQ.  JEND)  GO  TO  754 

DEPOS 

468 

JJ=JJ+1  $  XPL ( J J ) =X ( J ) 

DEPOS 

469 

I T I TLE ( 9 ) = 1 OHDEPTH  -  CM 

DEPOS 

470 

DO  753  NN= 1 0, 24 

DEPOS 

471 

753 

I T I TLE ( NN )  =  1  OH 

DEPOS 

472 

L  =  L+1 

DEPOS 

473 

754 

CONTINUE 

DEPOS 

474 

JMAX= J J 

DEPOS 

475 

DO  776  1=1,4 

DEPOS 

476 

IF  ( I  PLOT (  I  )  .EQ.  0)  GO  TO  776 

DEPOS 

477 

GO  TO  (756, 758, 760) I 

DEPOS 

478 

756 

I T I TLE ( 1 7 )  =  1  OH ABSORBED  E  $  I T I TLE ( 1 8 )  =  1 OHNERGY  -  CA 

DEPOS 

479 

I T I TLE ( 19)=10HL/G  $  GO  TO  762 

DEPOS 

480 

758 

I T I TLE ( 1 7 )  =  1 OHTEMP .  FROM  $  I T I TLE ( 1 8 )  =  1  OH 

ABS.  ENER 

DEPOS 

481 

I T I TLE ( 1 9 ) = 1 OHGY  -  DEG  C 

DEPOS 

482 

GO  TO  762 

DEPOS 

483 

760 

I T I TLE ( 1 7 ) = 1 OHPSEUDO  PRE  $  I T I TLE ( 1 8 ) = 1 OHSSURE  AT  D 

DEPOS 

484 

I T I TLE ( 1 9 ) = 1 OHEP .  -  KBAR 

DEPOS 

485 

762 

CONTINUE 

DEPOS 

486 

L= 1  $  JJ=1  $  YPL ( 1 ) =FR0NT (1,1) 

DEPOS 

487 

DO  774  J=1 , JEND 

DEPOS 

488 

JJ= JJ+1 

DEPOS 

489 

GO  TO  (769,770,771 )  I 

DEPOS 

490 

769 

YPL ( J J ) =CPG ( J )  $  GO  TO  772 

DEPOS 

491 

770 

YPL ( J J ) =  TC ( J )  $  GO  TO  772 

DEPOS 

492 

771 

YPL ( J J ) =  P(J)  $  GO  TO  772 

DEPOS 

493 

772 

IF  (J  .LT.  JBND ( L ) )  GO  TO  774 

DEPOS 

494 

IF  (J  .EQ.  JEND)  GO  TO  774 

DEPOS 

495 

JJ  =  JJ  +  1  $  L=  L+ 1 

DEPOS 

496 

216 


SUBROUTINE  DEPOS  (Concluded) 


YPL ( J J ) = FRONT ( I , L ) 

DEPOS 

497 

774 

CONTINUE 

DEPOS 

496 

CALL  GRAPH4CXPL, YPL,  JMAX,  1 

1 , XMAXC I  ) j  XM I N ( I ) j YMAX( I  ) , YM I N ( I  ) ,  I  TITLE,  DEPOS 

499 

1  I  A) 

DEPOS 

500 

776 

CONTINUE 

DEPOS 

501 

780 

RETURN 

DEPOS 

502 

END 

DEPOS 

503 

217 
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SUBROUTINE  DFRACT 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


.  E-9 )  DVO  = 1 . E-9 


)  TSR(M,7)=8. *3. 1416*TSR(M,3)**3*TSR(M,4) 


1  00 


SUBROUTINE  DFRACT (SXX, SYY  , STT , TXY , EXX1 , EYY1 , ETT1 , EXY 1 ,  P, NM, NT, DHO, 
1  DOLDO, DTO, EOLD, EH, EQSTCM, EQSTGM, ELMU, RHOS, TSR, Y, YD, F,M, J,K, ALFA) 

PJ  ESTIMATE  OF  PRESSURE 

PA  COMPUTED  PRESSURE  BASED  ON  PJ 

PN, PG  PRESSURES  ASSOCIATED  WITH  NUCLEAT I  ON  AND  GROWTH 

NM  RELATIVE  VOID  VOLUME 

NT  VOID  DENSITY,  NUMBER/CM3 

TSR(I)  GROWTH  CONSTANT  =  3/(4*ETA) 

TSR ( 2 )  GROWTH  THRESHOLD,  DYN/CM2 

TSR ( 3)  NUCLEAT I  ON  RADIUS  PARAMETER,  CM 

TSR (4 ) ,  PARAMETERS  IN  THE  NUCLEAT I  ON  FUNCTION  : 

TSR ( 6 )  NDOT  =  T4*EXP ( ( P -TSR ( 5 ) ) /TSR ( 6 ) ) 

TSR ( 5 )  NUCLEAT I  ON  THRESHOLD,  DYN/CM2 
WO,  VVA  VOID  VOLUME,  CM3/G 

VGA  VOID  VOLUME  ASSOCIATED  WITH  GROWTH,  CM3/G 

VNA  VOID  VOLUME  ASSOCIATED  WITH  NUCLEAT I  ON,  CM3/G 

DIMENSION  TSR ( 6 , 30 ) 

REAL  NM , NT 
DATA  SMF/1 . 88/ 

IF  (NM  .LT.  0. )  RETURN 

NTRY  =  0 

DOLD  =  DOLDO 

VVO  =  NM/DOLD 

VVA  =  WO 

VSG=1  .  /DOLD-WO 
PSG=P/ ( VSO*DOLD ) 

DVO= 1 . /DHO- 1 . /DOLD 
IF  (ABS(DVO)  .LT.  1 
DV  =  DVO 

IF  ( TSR ( M, 7 )  .EQ.  0. 

BEGIN  SUBCYCLING  LOOP  FOR  CASE  OF  LARGE  STRAIN 

NL00P-MAX1 (1 . , -2. * DV * EQSTCM /VSO/ TSR (M, 5) +0 .5,2. 5*TSR(M, 1 ) *DTO* 

1  AM  INI  (P-TSRCM, 2) , TSR CM, 2) ) ) 

DELV  =  DV/NLGOP 
EXX  =  EXX 1 *DELV/DVO 
EYY=EYY1 *DELV/DVO 
ETT  =  ETT1 *DELV/DVO 
EXY=EXY1 *DELV/DVO 
VH= 1 . /DOLD 
YT  =  Y 

DT  = DELV/DVO*DTO 
A 1 =  TSR ( M,  1  ) *DT 

DPJ  =  0 . 2* ( ABS ( TSR ( M, 5 )  )+ABS(P) ) 

DO  380  NL= 1 , NLOOP 
VH= VH+DELV 
DH= 1 . /VH 

DE=(EH-E0LD)*(VH-1 ./DOLD)/DVO 
E= (EH-EOLD) *(VH-1 . /DOLDO ) /DVO+EOLD 
TEMPI  -  1  . - RHOS* EQSTGM* E/ EQSTCM 

ESTIMATE  OF  PRESSURE  BASED  ON  STRAIN,  GROWTH,  NUCLEAT I  ON 

PN  =  0 . 

YS=VS0**2*RH0S/EQSTCM 
YSC=YS* (PSO+RHOS* EQSTGM* DE) 

DVS=  DELV 

PG= AMAX 1 ( ( YSC -DELV ) /YS, EQSTCM*( 1 . /RHOS/ ( VSO+DELV) -TEMPI ) ) 

PS=  PG 
P  J  =  F  3 

I F ( C . 5* ( P J+PSO )  .GT.  AMAX1 (TSRCM, 2) , TSRCM, 5) ) )G0  TO  300 
IF  (DELV  .GT.  0.)  PN=2 . *TSR (M, 6 ) *ALOG ( DELV* DH/ TSR ( M , 7) /DT ) + 

1  2 . *TSR ( M , 5 )  -  PSO 

IF  (WO  .LE.  0.  )  GO  TO  150 
XN  =  0 .  $  XP=1  . 0 

IF  (PSO  .LT.  TSR ( M , 5 ) )  XN=TSR(M, 7) /DH*DT*EXP( (PSO -TSR (M, 5) ) /TSR 
1  ( M,  6  )  ) 

IF  (PSO  .LT.  TSR ( M, 2 ) )  XP=EXP(A1 * (PSO-TSR(M, 2) )) 

YG=VV0*XP*A1/2. 

YGC=  WO*  (XP-1  .  ) -YG*PSO 
YN=XN/(2. *TSR(M,  6) ) 

YNC=XN- YN*PSO 

PG= ( DELV-YSC-YGC-YNC) / ( -YS+YG+YN) 
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2 
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4 

5 

6 

7 
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20 
21 
22 

23 
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33 
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41 
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45 
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48 
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67 

68 

69 

70 

71 

72 

73 

74 

75 

76 
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SUBROUTINE  DFRACT  (Continued) 


CH=  1  . 

IF  (0. 5*  C  PG+PSO ) .GT,  TSR (M, 2) ) YG  =  YGC=CH  =  0 , 

IF  (0. 5* (PG+PSO) .GT.  TSR (M, 5 ) ) YN  =  YNC=CH  =  0 . 

I F ( CH . EQ . 0 . ) PG= ( DELV-YSC-YGC-YNC) / ( -YS+YG+YN) 

I F ( DELV . GT . 0 .  .AND.  PSO  .LT.  TSR ( M , 2 ) ) PG=AM I N 1 ( PG , TSR CM , 2 ) ) 

P J  =  AMAX 1  ( PS ,  PG, PN) 

150  DVS= 1 . /RHOS/ ( PJ/EQSTCM+TEMP1 ) -VSO 
VVA=VVO+DELV-DVS 
NC  =  0 . 

C  BEGIN  ITERATION  LOOP 

200  NC  =  NC+ 1 

VV= VVO+DELV-DVS 

PJ  =  PA  =  EQSTCM* ( 1  . /RHOS/ ( VSO+DVS ) -TEMPI  ) 

PN= AM I N 1 (0. 5* (PA+PSO) -TSR(M, 5) , 0. ) 

IF  (PN  .LT.  0.)  PN=EXP ( PN/TSR ( M ,  6) ) 

VNA=TSR (M, 7)*PN*DT/DH 
VGA=VVO 

PG  =  AM I N 1 ( 0 . 5* ( PA+PSO ) -TSRCMj  2) , 0 . ) 

IF  (PG  .LT.  0.)  VGA  =  WO*  EXP  ( A1  *PG) 

VVA=VGA+VNA 

DVSA= 1  . /RHOS/ ( PJ/EQSTCM+TEMP 1  ) -VSO 
DELVA  =  DVSA+VVA- WO 

C  TEST  FOR  COMPLETION  OF  ITERATIONS 

IF  ( ABS ( DELVA-DELV ) /VSO  .LT.  2.E-5  .AND.  ABS ( DVS-DVSA ) /VSO  . LT . 
1  1 . E-5)  GO  TO  300 

I F ( NC . LT . 30 )  GO  TO  250 
I F ( NTRY . LT . 5 ) GO  TO  450 

PRINT  1 250jJjKjMj PJ, DELV, DELVA, DELVB, DELVC 
GO  TO  300 

DELVA  IS  RECENT  VALUE,  DELVB  IS  LARGER  STORED  VALUE,  AND 
DELVC  IS  SMALLER  STORED  VALUE. 

250  IF(NC.EQ.I)  GO  TO  270 

I F ( NC  . EQ.  2)  GO  TO  260 
IF  (DELVC  .GT.  DELV)  GO  TO  265 

IF  (DELVB  .LT.  DELV)  GO  TO  260 

IF  (DELVA  .GT.  DELV)  GO  TO  265 

260  DVS=DVSA+ ( DVSB-DVSA) / ( DELVB -DELVA ) * ( DELV -DELVA) 

I F (MOD ( NC+2, 3) . EQ. 0)  DVS= . 5* ( DVSA+DVSB ) 

GO  TO  275 

265  DVS=DVSA+(DVSC-DVSA) /(DELVC -DELVA) *( DELV -DELVA ) 

I F ( MOD ( NC+2, 3) . EQ . 0)  DVS= . 5* ( DVSA+DVSC ) 

GO  TO  275 

270  P J  =  PA+ ( DELV -DELVA ) / ( VGA* A1 /2 .  - YS  +VNA/2 . /TSR ( M, 6 ) ) 

PN  =  P  J 

IF  ( VNA+DELV -DELVA  .GT.  0.  .AND.  VNA  . GT .  0.)  PN=2 . *TSR (M, 6 ) * 

1  ALOG( ( VNA+DELV-DELVA ) /VNA )  +  PA 
P J  =  AMAX 1  ( P J , 0 . 5* ( PN  +  PJ ) ) 

P J  =  PA+S I GN ( AM I N 1  (ABS(PJ-PA) , DP J ) , DELVA-DELV) 

DVS=VSO* ( 1 ./(I . +(PJ*YS-YSC)/VSO) -1 . ) 

275  I F ( NC  ~2 )  290,285,280 

280  I F ( ( DELVB . GT . DELV . AND . DELVA . GT . DELVB ) . OR . 

C  (DELVA. LT.DELVC.AND.DELVC.LT. DELV))  GO  TO  200 
I F ( DELVC . GT . DELV . OR . ( DELVB . GT . DELV . AND . DELVA . GT . DELV ) ) 

C  GO  TO  290 
285  DELVC  =  DELVA 
DVSC  =  DVSA 
GO  TO  292 
290  DELVB  =  DELVA 
DVSB  -  DVSA 
I F ( NC . EQ . 1 )  GO  TO  200 
292  IF(DELVB.GT. DELVC)  GO  TO  200 
DELVA  =  DELVB 
DVSA  =  DVSB 
DELVB  =  DELVC 
DVSB  =  DVSC 
DELVC  =  DELVA 
DVSC  =  DVSA 
GO  TO  200 

ENDING  ROUTINE 

300  NM=VVA*DH 

NT=NT*DH/DOLD+TSR(M, 4) *PN*DT 
I F( NM  .GT.  0.6)  GO  TO  400 
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77 

DFRACT2 

78 
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79 

DFRACT2 

80 

DFRACT2 
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1 0/8/79 

34 

DFRACT2 

83 

DFRACT2 

84 
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85 

DFRACT2 

86 

DFRACT2 

87 

DFRACT2 

88 

DFRACT  2 

89 

DFRACT2 

90 

DFRACT2 

91 

1 0/8/79 

35 

DFRACT2 

94 

DFRACT  2 

95 

DFRACT2 

96 

1 0/8/79 

36 
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98 
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99 

DFRACT2 

1  00 
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1  04 

DFRACT  2 

1  05 

DFRACT2 

106 

DFRACT  2 

107 

DFRACT2 

108 

DFRACT2 

109 

DFRACT2 

1  10 

DFRACT2 

1  1  1 

DFRACT2 

1  12 

DFRACT2 

1  13 

DFRACT2 

1  14 

DFRACT  2 

1  15 

DFRACT2 

1  16 

DFRACT2 

1  17 

DFRACT2 

1  1  8 

10/8/79 

37 

DFRACT  2 

120 

DFRACT2 

121 

1 0/8/79 

38 

DFRACT2 

1  23 

DFRACT  2 

1  24 

DFRACT2 

1  25 

DFRACT2 

1  26 

DFRACT  2 

127 

DFRACT  2 

1  28 

DFRACT2 

129 

1 0/8/79 

39 

1 0/8/79 

40 

1 0/8/79 

41 

10/8/79 

42 

1 0/8/79 

43 

1 0/8/79 

44 

1 0/8/79 

45 

10/8/79 

46 

10/8/79 

47 

1 0/8/79 

48 

1 0/8/79 

49 

1 0/8/79 

50 

10/8/79 

51 

1 0/8/79 

52 

10/8/79 

53 

1 0/8/79 

54 

10/8/79 

55 
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56 
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DFRACT2 

148 
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DFRACT2 

151 

DFRACT2 
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SUBROUTINE  DFRACT  (Concluded) 


BETA  =  2 ,  *TXY*ALFA/NLOOP 

ELMUF  =  2  .  *ELMU* AMAX 1  (  1  .  -SMF*WA*DHj  0.  ) 

WS1 =0. 6667* ( DOLD-DH ) / ( DOLD+DH ) 

TXV  =  TXY+ELMUF*EXY+ ( SYV -SXX ) *ALFA/NLOOP 
SXX=SXX+ELMUF* (EXX-WS1 ) +BETA 
SYY=SYY+ELMUF* (EYY-WS1 ) -BETA 
STT  =  STT+ ELMUF  * ( ETT-WS1  ) 

WS4=SXX*  *2+SYY*  *2+STT *  *2+2 . *TXY**2 
YE  =  Y  *F*AMAX 1  ( 1  . -4 . *VVA*DH , 0 .  ) 

IF  ( WS4  .LT.  YE*  *2/ 1.5)  GO  TO  340 
WS3=YE/SQRT( 1 . 5*WS4) 

PTERM=  (  DOLD-DH  )  /  (  DOLD+DH  )  /DT/TSRCM,  1  ) 

WS5  = 1 . 5/TSR ( M , 1 )/DT 
SXX=SXX*WS3+EXX*WS5-PTERM 
SYY=SYY*WS3+EYY*WS5-PTERM 
STT  =  STT  *WS3+ETT  *WS5-PTERM 
TXY  =  TXY  * WS3+EXY  *  WS5 
340  CONTINUE 
PSO=PJ 

P=PJ* ( VSO+DVS ) *DH 

Y  =  YT 
VVO  =  WA 
VSO=VH-VVA 

380  DOLD=DH 
RETURN 

END  WITH  SEPARATION 
400  P=0 . 

Y  =  0 
SXX=0. 

SYY=0 . 

STT  =  0 . 

TXY  =  0 . 

NM= -ABS  C  NM ) 

RETURN 

PROVISION  FOR  ABORT  IN  CASE  OF  ITERATION  FAILURE 
450  NTRY  =  NTRY  + 1 

DV= 1 . /DHO-1 . /DOLD 

NLOOP  =  MAX 1  ( 3 .  j  ~4 . *2 , **NTRY*DV*EQSTCM/VSO/TSR(MJ  5)+0. 5) 

GO  TO  100 
C  FORMATS 

1250  FORMAT  f30H  ITERATION  FAILURE  IN  DFRACT/5H  JJK=2I2,3H  M=I2, 

1  4H  P J  = 1  PE 1 0 . 3 , 6H  DELV  =  E1 0 . 3, 7H  DELVA  =  E1 0 . 3, 7H  DELVBsEIO.3, 

2  7H  DELVC=E1 0.3) 

END 


DFRACT2 

1  53 

DFRACT2 

1  54 

DFRACT2 

1  55 
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57 

DFRACT2 

1  57 

DFRACT2 

1  58 

DFRACT2 

1  59 

DFRACT2 

1  60 

DFRACT2 

1  61 

DFRACT2 

1  62 

DFRACT2 

1  63 

DFRACT2 

1  64 

DFRACT2 

1  65 

DFRACT2 

1  66 

DFRACT2 
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DFRACT2 

1  68 

1 0/8/79 
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DFRACT2 
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184 
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SUBROUTINE  EDIT 


SUBROUTINE  EDIT 

*  EDIT  LISTS 
INPUT  -  JSTAR. 
OUTPUT  -  NTEX . 


COOROINATE  QUANTITIES  FOR  TIME  OF  TEOIT 


INTEGER  H t POROUS t PRESS, R INTER* SOLID * SPALL 
REAL  MATL»NEM,NET*NEMH*NETH 
MISCELLANEOUS 

COMMON  A ZERO ( 1 ) * CEF * CKS * OA VG t OELT I M * D I SCPT (10) * DOLO * ORHO , OTMA X , 

1  DTMIN*OTN*OTNH*DU*OX,EOLD*F*FAC*FIRST* J* JCYCS* JINIT* 

2  JFINf JREZON  (  IS)  * JSMAX , JSTAR * JTS * LSU8 ( 30 )  *M*MAXPR(30> *N*NCYCS, 

3  NEDITf NPERN,NR,NREZON,NSCRB  (6)  * NSEPRAT * NSPALL * NTEDT * 

4  NTEX  *  NTR (15) *POLD*P6(20) *R(30)  t RL AST * SL AST  * SMAX * TEO I T ( 50 )  * 

5  TF*TIME*TJ* TREZON,TS*T6(20)  , UL AST *UOLD * UZERO *  XL AST  * XNOW * XOLD 

1  *  X JD I T ( 20 ) 

HALFSTFP  VALUES 

COMMON  DH* OHLAST*DUH*EH* PH . RH * RHLAST * SH * SHL AS T * UH , UHL AS T *  XH * XHL AS TPUFCOM 1 3 


EDIT 
EDIT 
EDIT 
EDIT 
EDIT 
EOIT 
PUFCOM 
PUFCOM 
PUFCOM 
PUFCOM 
PUFCOM 
PUFCOM 
PUFCOM 
PUFCOM 
PUF  COM  1 0 

PUFCOM! i 
PUFCOM 1 2 


1  *nemh*neth 

CONO I T ION  INOICATORS 

COMMON  I NF,L INTER* MIRROR* NORMAL f POROUS » PRESS  PRINTER, SOL  10 ,SPALl 
cell  layout 

COMMON  DXX (30) * JBND(30)  *  JM AT  (30)  *  NAUTO  *  MATL (6*2)  * NL A YER * NMTRLS * 

1  THK  (30) 

COORDINATE  ARRAYS 

COMMON/COORD/X  (2U0  ]  ,X0  .CHL(200>  P DHL  t200)  ,0FDD{2OC J  iDPDE  (200) 

1  EhL  (  200  S  3)  *  M  ( 2  0  0  >  <  NL  T  t  2  0  U  >  »PHL(200?  iRHU20C)  *  SOT  (£00)  9 

2  SHL  (2O0>  tiil£00)  *1THL4?aO)  «ZHL  (2001 

COMMON  /IhD/  lEOStft)  iINDKE20)iNALPHA*NCNP(6)  iNFRE6)  i 

1  NDS (e)  iNPR  fb> t NCON ( 6 )  iNVAR  ffci) 

COMMON  /FES/  LVMAXiLVTOTtLVARiZOa) *COM <40001 
DIMENSION  Pi  L30DJ  fP2«3D0)  *|MUM(3UQ> 


PRINTOUT  FOR  EACH  EOIT 
NTEX=NTEX*1 

CALL  SECOND (CHANGE)  $  OUR =CHANGE -FIRST 

JSTARD  =  MINO ( JSTAR^l * JFIN-l )  $  NPTS  =  JST ARD- J I N I T ♦  1 

WRITE  (6f 1025) (OISCPT (I) *1=1*10) 

WRITE (6* 1026) NTEX *N, TIME* JST ARfDURfDTNH 
EMSUM  =  EMOM(JINIT)  =  0# 

J 1 = J I  NIT  $  L= 1  $  M  =  JMAT(L) 


PUFCOM 1 4 
PUFCOM 1 5 
PUFCOM 1 6 
PUFCOM 1 7 
PUFCOM 1 8 
PUFCOM 1 9 
PUFCOM20 
C00RDCO2 
*C00R0CQ3 
C00RDC04 
C00RDC05 

INUCOM  2 
INDCOM  3 


EDIT 

EDIT 

EOIT 

EDIT 

EDIT 

EDIT 

EDIT 

EDIT 

EOIT 

EDIT 

EDIT 

EOIT 

EDIT 


11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 
23 


4 

J2  = 

:  M I N  0 ( JSTARO* 

JBND  (L) ) 

EOIT 

24 

NJ  = 

i  J2- J1  ♦  1 

EDIT 

25 

IF 

(NPR(M)  *  EQ  . 

1)  bO  TO  7 

EDIT 

26 

IF 

(NFR(M)  .EQ. 

1  .OR.  NFR(M)  .EQ. 

2)  GO  TO  7 

EDIT 

27 

IF 

(NFR(M)  .EQ. 

3)  GO  TO  5 

EDIT 

23 

IF 

(NPOR(M)  , EQ 

.  3)  GO  TO  10 

EOIT 

29 

IF 

(NDS (M) . EQ • 0 

.OR.  NDS(M) . EQ .  1  . 

OR.  NDS (M) • EQ •  4 )  GO  TO  5 

EDIT 

30 

IF 

(NPOR(M)  .EQ 

.  4)  GO  TO  9 

EDIT 

31 

GO 

TO  7 

edit 

32 

5 

DO 

6  J=J1*J2 

EDIT 

33 

Pi  ( 

J)=YHL(J) 

EDIT 

34 

6 

P2  ( 

J) =SHL ( J) -PHL ( J) 

EDIT 

35 

IF 

(NFR(M)  .GE. 

3)  GO  TO  10 

EDIT 

36 

N 1 

=  10H  YIELO 

S  N2  =  10H  DEVIATOR 

EDIT 

37 

GO 

TO  13 

EDIT 

38 

7 

DO 

8  J=J1,J2 

EDIT 

39 

Pi  ( 

J ) =NE  M ( J ) 

EOIT 

40 

8 

P2  ( 

J ) =NE  T ( J ) 

EDIT 

41 

N 1 

=  10H  NEM 

$  N2  =  10H 

NET 

EOIT 

42 

IF 

(NPR(M)  .EQ. 

1)  N 1  =  10H  FBURN 

EOIT 

43 

IF 

(NFR(M)  .NE. 

0)  NlslOH  R V V 

EOIT 

44 

GO 

TO  13 

edit 

45 

9 

N  1  E 

10H  EVP 

$  N2=10H  DEVIATOR 

EDIT 

46 

DO 

91  J=J1*J2 

edit 

47 
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SUBROUTINE  EDIT  (Concluded) 


Pl ( J)=NEM< J) 

EDIT 

46 

91 

P2 ( J) =SHL (J) -PHL ( J) 

EDIT 

49 

GO  TO  13 

EO  I  T 

60 

10 

00  11  J=J1,J2 

EDIT 

51 

IF  ( H ( J  *  3 ) -2 )  101*11*102 

EDIT 

52 

101 

PI ( J) =NEM( J) 

edit 

53 

P2 ( J) =NET ( J) 

EDIT 

64 

GO  TO  11 

EDIT 

55 

10? 

LV=LVAR ( J) 

EDIT 

56 

IF  (NPOR(M)  ,EU.  3  .ANO.  H(J.3>  .EG*  5R  M )  LV=LVAP(J)*3 

EO  I  T 

57 

Pl ( J)=COM(LV) 

EDIT 

58 

P2(J)=COM(LV*l) 

EDIT 

59 

11 

CONTINUE 

EDIT 

60 

Nl=10H  Y/NEM/RVV 

EDIT 

61 

N2=10HSD/NET/ENV 

edit 

62 

13 

CONTINUE 

EDIT 

63 

DO  14  J=J1.J2 

edit 

64 

14 

EMOM ( J* 1 ) =EMSUM=0.5*ZHL ( J) * (U( J) *U ( J+l ) ) +EMSUM 

EDIT 

65 

WRITE  (6*1029)  N1.N2 

EDIT 

66 

I F (DHL ( J2 )  ,GT.  1.)  WR I TE ( 6  *  1 028 )  ( J » X ( J ) * U ( J ) . RHL ( J ) . PHL ( J ) * SHL ( J ) EO I T 

67 

1  *  EHL ( J ) .DHL ( J) * CHL ( J ) *(H(J. 11*1*1* 3) .MATL  <M. 1 ) .EMOM ( J) , P 1 < J ) . P2 ( J ) ED  I T 

68 

2* J=J1 * J2> 

EDIT 

69 

I F ( DHL ( J2 )  »LE.  1.)  WR I TE ( 6 . 1  027 )  ( J . X ( J ) , U ( J ) . RHL ( J ) . PHL ( J ) * SHL ( J > ED  I T 

70 

1 *FHL ( J) .DHL ( J) . CHL <J).<H<J,I),I=1*3>  *  MATL (M, 1 ) ,EMOM ( J) * P 1 ( J ) . P2 ( J >  ED  I T 

71 

2  *  J* J1 * J2> 

EDIT 

72 

IF  ( J2  .EQ.  JSTARO)  GO  TO  20 

EDIT 

73 

J 1 = J2+ 1 

EDIT 

74 

L  =  L *  1  $  M  =  JMAT(L)  $  GO  TO  4 

EDIT 

75 

20 

CONTINUE 

EDIT 

76 

Rfc TURN 

EDIT 

77 

1025 

FORMAT  ( 1H0* 1 0 A 1 0 ) 

EO  I  T 

78 

1026 

F ORMAT ( 1 8Ho  TIME  EDIT  N0.l3*7H  AT  N  =15. 8H,  TIME  =1PE12.5* 

EDIT 

79 

1  1 4H  SECS.  JSTAR  =  1 5  » 1 4H »  CALC  TIME  IS  0PFl0.3*13H  SECS.  DTNH  = 

EDIT 

BO 

2  1  PE  1 0 • 3 • 5H  SECS/) 

EDIT 

81 

1027 

FORMAT (I5.0PF9.6.F9.0.lP4E10.3*OPF8.6» IPEll .4.3R2.1X.A9. 1  PE  10. 3* 

EO  I  T 

82 

1  1P2E11.3) 

EDIT 

83 

1026 

FORMAT(I5.0PF9,6.F9.0.lP4El0.3*0PF8.4.1PEll,4.3R2.lX.A9.1PE10.3t 

EDIT 

84 

1  1P2E11.3) 

EDIT 

85 

1029 

FORMAT  (4X. 1HJ.8X. 1HX.8X. 1HU.7X.3HRHL.7X.3HPHL.7X.3HSHL.7X.3HEHL. 

EO  I  T 

86 

1  5X.3HDHL.8X.3HCHL.2X.4HC0ND. 17X.3HM0M, 1X.A10* IX. A  10/ 

EDIT 

87 

2  5H  CELL.7X.2HCM.3X.6HCM/SEC.3U0H  0YN/CM2  )  .  6X  .  4HERGS .  2X , 

EDIT 

88 

3  6HGM/CM3.5X.6HCM/SEC.22X.4HTAPS) 

EO  I  T 

89 

ENO 

EDIT 

90 
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SUBROUTINE  EOSTAB 


SUBROUTINE  EOSTAB ( NCALL , IN,XN,YN,ZN) 

EOSTAB 

2 

DIMENSION  X(30)J2(30)JEX(30) 

EOSTAB 

3 

IF  ( NCALL  .GT.  0)  GO  TO  100 

EOSTAB 

4 

c 

EOSTAB 

5 

c 

INITIALIZE  AND  READ  DATA 

EOSTAB 

6 

c 

EOSTAB 

7 

READ  (I  N ,  1 001  )  A 1  ,  I  MAX j  12,13 

1 0/8/79 

1 

IF  (12  .NE.  1  OH  VOLUME  )  I2=10H  DENSITY 

EOSTAB 

9 

IF  (13  .NE.  1  OH  LOG  )  I 3=1  OH  LINEAR 

EOSTAB 

1  0 

PRINT  1001 j  A 1 ,  I  MAX  ,  12,13 

EOSTAB 

1  1 

PRINT  1003, IN 

EOSTAB 

1  2 

READ  (IN, 1002)  A1 , ( X ( I ) , Z ( I ) ,  I=1,IMAX) 

EOSTAB 

13 

PRINT  1 01 2, A1 ,  (X ( I  ) , Z( I  ) ,  1=1,1  MAX ) 

EOSTAB 

14 

c 

VOLUME  TRANSFORMATION 

EOSTAB 

1  5 

IF  (12  .NE.  1  OH  VOLUME  )  GO  TO  45 

EOSTAB 

1  6 

DO  30  1=1,  I  MAX 

EOSTAB 

1  7 

30 

XU  )  =  1  ./XU  ) 

EOSTAB 

1  8 

45 

I  Ml  =  I  MAX- 1 

EOSTAB 

19 

DO  50  I = 1  ,  I  Ml 

EOSTAB 

20 

50 

EXC I )=CZ( 1+1 ) -Z( I ) )/(X( 1+1 )-XC I ) ) 

EOSTAB 

21 

IF  (13  .NE.  1 0H  LOG  )  GO  TO  80 

EOSTAB 

22 

DO  65  1=1,  I  Ml 

EOSTAB 

23 

IF  (Z(I)  .LE.  0.  .OR.  ZU+1)  .LE.  0.)  GO  TO  65 

EOSTAB 

24 

EX (I ) = ALOG ( Z ( 1+1 )/Z(I ) ) /ALOGCXC I +1 ) /X ( I ) ) 

EOSTAB 

25 

65 

CONTINUE 

EOSTAB 

26 

80 

I M2= I  MAX- 2 

EOSTAB 

27 

N1  =2 

EOSTAB 

28 

NM= I  MAX - 1 

EOSTAB 

29 

NORDER= 1 

EOSTAB 

30 

IF  C  X  C 1  )  . LT.  X ( 2 ) )  RETURN 

EOSTAB 

31 

N0RDER=O 

EOSTAB 

32 

N 1  =  I  MAX - 1 

EOSTAB 

33 

NM=  2 

EOSTAB 

34 

I M2= I  MAX- 1 

10/8/79 

2 

RETURN 

EOSTAB 

35 

C 

EOSTAB 

36 

C 

CALCULATE  PRESSURE 

EOSTAB 

37 

100 

I T=N 1 -NORDER 

EOSTAB 

38 

IF  (XN  . LT.  X ( N 1  ) )  GO  TO  1  75 

EOSTAB 

39 

I T  =  NM- 1 +NORDER 

EOSTAB 

40 

IF  (XN  .GT.  X ( NM ) )  GO  TO  175 

EOSTAB 

41 

DO  140  I =2,  I  M2 

EOSTAB 

42 

N4  = I + 1 

EOSTAB 

43 

IF  (NORDER  .EQ.  0)  N4=IMAX-I+1 

10/8/79 

3 

I T  =  N4 -NORDER 

EOSTAB 

45 

IF  (XN  .LT.  X ( N4 ) )  GO  TO  175 

EOSTAB 

46 

140 

CONTINUE 

EOSTAB 

47 

1  75 

IF  (13  .EQ.  1  OH  LOG  )  GO  TO  190 

EOSTAB 

48 

1  80 

ZN=Z ( IT)+(XN-X( IT) )#EX( IT) 

EOSTAB 

49 

RETURN 

EOSTAB 

50 

1  90 

IF  ( Z  (  IT)  .LE.  0.  .OR.  ZUT+1)  .LE.  0.)  GO  TO  180 

EOSTAB 

51 

ZN  =  Z ( I T)* (XN/XC I T) ) *  *  EX (IT) 

EOSTAB 

52 

RETURN 

EOSTAB 

53 

1  001 

FORMAT ( A1 0 , I 10,2A10) 

EOSTAB 

54 

1  002 

FORMAT (A10,6E10.3/(1 OX, 6E1 0. 3) ) 

EOSTAB 

55 

1003 

FORMAT ( 1 H+, 79X, 4H  IN=,I2,11H  EOSTAB  P-V  ) 

EOSTAB 

56 

1012 

FORMAT (A10,  1 P6E1 0 . 3/C 1  OX, 6E1 0 . 3) ) 

EOSTAB 

57 

END 

EOSTAB 

58 
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SUBROUTINE  EQST 


C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINE  EQST ( E J * 0 J , P J f M J , C J , DPDD J , DPDE J ) 

COMPUTES  PRESSURE  AND  SOUND  SPEED  FOR  SOLIDS  AND  EXPLOSIVES 
«  M I E-GRUNE I  SEN  FOR  COMPRESSION 
PUFF  HUGONIOT  IN  P  -  MU  FORM 
MURNAGHAN  HUGONIOT  FORM  (FOR  EQSTS=1.0> 

LINEAR  US-UP  HUGONIOT  FORM  (FOR  EQSTS=2.0> 

*  EXPANSION  EQUATION  OF  STATE  FOR  DENSITIES  LESS  THAN  RHOS 

*  POLYTROPIC  GAS  EQUATION  FOR  EXPLOSIVES  (NPR*l ) 

INPUT  -  FORMAL  PARAMETERS  EJ*  DJ*  MJ,  CJ. 

OUTPUT  -  PJ*  CJ. 

NAMED  COMMON 
REAL  MU  f  MUM 

COMMON  /EOS/  EQST A (6)  *EQSTC  (6)  *  EQSTD ( 6)  ♦ EQSTE ( 6 )  *EQSTG(6)  * 

1  EQSTH(6>  *EQSTN ( 6 ) *  EQSTS ( 6 ) * EQSTV (6) *CZQ(6>  *CWQ(6> tC2(6) 
COMMON 
COMMON 
COMMON 
COMMON 
COMMON 


EQST 

EQST 

EQST 

EQST 

EQST 

EQST 

EQST 

EQST 

EQST 

EQST 

EQST 

EQST 


2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 


/MELT/  EMELT (6*5) »SPH(6> *  THERM (6*8) 

/RHO/  PHO (6) *  RHOS ( 6 ) 

/TSR/  TSR (6*30)  *  EXMAT (6*20)  *TENS(6*3) 

/Y/  YO (6)  ,  YADD ( 6 ) *MU<6> *  MUM  *  Y ADDM 

/IND/  I  EOS (6)  »INDK(20)  , N ALPHA f NCMP ( 6 ) »NFR (6 )  ,NP0R(6)  , 
NDS  (6)  ,NPR  (6)  ,  NCON (6) ,NVAR (6) 

DIMENSION  NHUG (6)  *  AMURN (6)  *  BPMURN ( 6 )  *Sl (6) 


EXPLANATION  OF  SOME  MODIFIED  PUFF  EXPANSION  MODEL  PARAMETERS 

*  ABSOLUTE  VALUE  OF  EQST V  IS  EXPONENT  IN  GRUNE I  SEN  EXPRESSION, 

DEFAULT  VALUE  OF  EXPONENT  FOR  EQSTV=0.  IS  0.5 

*  IF  EQST V  .GT.  0.,  THEN  MCCLOSKE Y-THOMPSON  LOG  VARIATION  IS 

USED  FOR  EJ  .GT.  SUBL  ENERGY 

*  EQSTA  IS  THE  COEFFICIENT  OF  THE  SECOND  TERM  ASSUMED  IN  the 


EQSTCUM2 
EQSTCOM3 
EUSTC0M4 
EQSTC0M5 
EQSTC0M6 
EQSTCOM7 
EQSTCOMq 
EQSTC0M9 
INDCOM  2 
INDCOM  3 
EQST  16 
EQST 
EQST 
EQST 
EQST 
EQST 
EQST 
EQST 
EQST 


30 

35 


40 


GO  TO  (180*40*60)  NHUGM 

INITIALIZE  FOR  MURNAGHAN  HUGONIOT  FORM 
P  =  A* ( (D/RHOS) #*80P-1 . ) 

-A-*B0/80P  IS  READ  AS  -C-.  -BOP-  IS  READ  IN  AS  -D- 
AMURN(MJ)  *  EQSTC(MJ) 

RPMURN(MJ)  =  EQSTD(MJ) 

EQSTC(MJ)  =  EQSTC (MJ) *EQSTD (MJ) 

EQSTD(MJ)  =  0.5*EQSTC(MJ)*(EQSTD(MJ)-1.) 


17 

18 

19 

20 
21 
22 

23 

24 


GRUNEI SEN  SERIES  AND  A  NONZERO  VALUE 

INDICATES  THAT  THE 

EQST 

25 

PRESSURE-DENSITY  SLOPES  OF  MI E-GRUNE I SEN  EOS  AND  EXPANSION 

EQST 

26 

EOS  HAVE  BEEN  MATCHED  AT  THE  INITIAL 

SOLID  DENSITY. 

EQST 

27 

IF  EQSTA=0.  OR  IS  UNSPECIFIED.  THEN 

THE  PRESSURE-VOLUME 

EQST 

28 

SLOPE  IS  NOT  MATCHED. 

EQST 

29 

EQST 

30 

EQST 

31 

INITIALIZATION  PORTION 

<mmmm*EQST 

32 

EQST 

33 

IF  (EQSTN(MJ)  .GT.  0.)  GO  TO  200 

EQST 

34 

EOSTN(MJ)  =  1. 

EQST 

35 

IF  (EQSTG(MJ)*EGiSTE(MJ)*RHOS(MJ)  .NE.  0.) 

EQSTN (M J)  =  EQSTC ( M J ) / 

EQST 

36 

<EQSTG(MJ)*EQSTE(MJ)*RH0S(MJ) ) 

EQST 

37 

IF  (EQSTV(MJ)  .GT.  0.)  PRINT  1005 

EQST 

38 

ENN=ABS (EQSTV (MJ) ) 

EQST 

39 

IF  (EQSTV  ( M J )  .NE.  0.)  PRINT  1  007, ENN 

EQST 

40 

AMURN ( M J ) =0 . 

EQST 

41 

IF  (EQSTA (MJ)  .EQ.  0.)  GO  TO  35 

EQST 

42 

PRINT  1009, EQSTA (MJ) 

EQST 

43 

AMURN (MJ) = (EQSTA (MJ) ♦ENN* ( EQSTH ( M J ) -EQSTG ( M J ) ) )/EQSTG(MJ) 

EQST 

44 

IF  (AMURN(MJ) ♦EQSTN(MJ)  .GT.  0.)  GO  TO  30 

EQST 

45 

PRINT  1055, EQSTN (MJ) , AMURN (MJ) 

EQST 

46 

STOP 

EQST 

47 

EQSTA (MJ) =AMURN (MJ) 

EQST 

48 

CONTINUE 

EQST 

49 

NHUG(MJ)  =  1 

EQST 

50 

IF  (EQSTS(MJ)  .EQ.  1.)  NHUG(MJ)  =  2 

EQST 

51 

IF  (EQSTS(MJ)  .EQ.  2.)  NHUG ( M J )  =  3 

EQST 

52 

NHUGM  =  NHUG(MJ) 

EQST 

53 

EQST 

EQST 

EQST 


54 

55 

56 


EQST  57 
EQST  58 


EQST 

EQST 

EQST 


59 

60 
61 
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SUBROUTINE  EQST  (Continued) 


PRINT  1010.EQSTC (MJ) .EQSTD(MJ)  EQST 

GO  TO  180  EQST 

C  INITIALIZE  LINEAR  US-UP  HUGONIOT  FORM  EQST 

C  US  a  Cl  ♦  SI  *  UP  EQST 

C  -Cl-  IS  READ  IN  AS  -C-.  -SI-  IS  READ  IN  AS  -D-  EQST 

60  Sl(MJ)  =  EQSTD(MJ)  EQST 

EQSTC(MJ)  *  RHOS (MJ) *EQSTC (MJ) EQST 
EQSTD(MJ)  a  EQSTC (MJ) * (2.*EQSTD (MJ) -1 . >  EQST 

PRINT  1020»EQSTC (MJ) ,EQSTD (MJ)  EQST 

GO  TO  180  EQST 

180  IF  (EQSTN(MJ)  ,EQ.  1.)  PRINT  1050  EQST 

RETURN  EQST 

C  EQST 


C  COMPUTATION  PORTION  »***EQST 


C  EQST 

200  IF  (NPR(MJ)  .EQ.  1)  GO  TO  400  EQST 

AMU=1 .333*MUM  $  IF  (Ej  ,GT.  EMELT (MJ» 1 ) )  AMU*o.  EQST 

VJaRHOS (MJ) /DJ  $  EMU=(1.-VJ)/VJ  EQST 

IF  (EMU  .GE.  0.)  GO  TO  300  EQST 

C  EQST  FOR  EXPANDED  ZONES  EQST 

ENN=0 . 5  $  ESUBC=1.0  S  IF  (EQSTV(MJ)  ,NE.  0 .) ENN=ABS ( EQST V ( MJ )) EQST 

IF  ( EQST V ( M J )  ,GT.  0.  .AND.  EJ  .GT.  EQSTE (MJ) )  ESUBC=1 . + ALOG ( E J/  EQST 

1  EQSTE (MJ) )  EQST 

ERAT=EJ/EQSTE (MJ)  $  IF  (EJ  .GT.  EQSTE (MJ) )  ERAT=1.0  EQST 

ENU2= (EQSTN (MJ) +ERAT*EQSTA (MJ) ) * ( 1 ,-VJ) *VJ/ESUBC  EQST 

TS1=EQSTE (MJ) *ESUBC  EQST 

GHNU= (EQSTG (MJ) -EQSTH (MJ) ) /VJ**ENN  EQST 

EX2=0.  i  IF  (ENU2  .GT.  -10.)  EX2=EXP ( ENU2 )  EQST 

TSl  =  TSl*  (1 .-EX2)  EQST 

TS2=EQSTH(MJ) +GHNU  $  P J= ( EJ-TSl ) *D J*TS2  EQST 

IF  (EJ  .GT.  EMELT (MJ, l ) )  Pj=AMAXl (0. tPJ)  EQST 

IF  (CJ  .EQ.  1.)  GO  TO  BOO  EQST 

DPDPJ= (EJ-TSl ) * (TS2+ENN*GHNU) +TS2* (EQSTE (MJ) *ESUBC-TSl )  EQST 

1  *<EQSTN(MJ).ERAT*EQSTA(MJ> > /ESUBC* < 2. * V J- 1 . > *V J  EQST 

DPDEJ=DJ*TS2*(1.+EQSTA(MJ)*EX2*VJ*<1.-VJ)  )  EQST 

IF  ( EQST V ( M J )  ,LE.  0.  .AND.  EJ  .GT.  EQSTE ( MJ ) )  DPDEJ=DJ*TS2  EQST 

EXi=EX2* (1 .-ENU2)  EQST 

IF  (EQSTV(MJ)  .GT.  0.  .AND.  EJ  .GT.  EQSTE (MJ) )  DPDE J  =  D J*TS2* < 1 . -  EQST 

1  EQSTE (MJ) /EJ* ( 1 .-EXi ) )  EQST  1 

CSQaDPDDJ* (EJ-TSl > *TS2/DJ*DPDEJ+AMU/DJ  EQST  1 

GO  TO  450  EQST  1 

C  EQST  FOR  COMPRESSED  ZONES  EQST  1 

300  IF  ( NHUG ( M J ) -2 )  310.320.330  EQST  1 

C  PUFF  HUGONIOT  EQST  1 

310  PH  =  < (EQSTS (MJ) *EMU+EGSTD (MJ) > *EMU+EQSTC (MJ) ) *EMU  EQST  1 

DPHDD  =  < <3.*EQSTS (MJ) *EMU+2.*EQSTD (MJ) ) *EMU+EQSTC (MJ) ) /RHOS (MJ)  EQST  1 
GO  TO  370  EQST  1 

C  MURNAGHAN  HUGONIOT  EQST  1 

320  PH  a  AMURN(MJ)*< (DJ/RHOS(MJ) ) **BPMUHN < M J ) - 1 , )  EQST  1 

DPHDD  =  (EQSTC(MJ)+BPMURN(MJ)*PH)/DJ  EQST  1 

GO  TO  370  EQST  1 

C  LINEAR  US-UP  HUGONIOT  EQST  1 

330  PH  =  EQSTC(MJ) *(l ,-VJ)/ (1.-S1 (MJ)* (1 ,-VJ) )**2  EQST  1 

DPHDD  =  VJ/DJ*(1.+S1 (MJ)*(l.-VJ) )/(l.-Sl (MJ)*(l.-VJ) )**3  EQST  1 

C  COMPUTE  PRESSURE  DERIVATIVES  AND  SOUND  SPEED  EQST  1 

370  GF  =  l.-0.5*EQSTG(MJ)*(l.-VJ)  EQST  1 

PJ  c  PH*GF+EQSTG (MJ) *RHOS (MJ) *EJ  EQST  1 

IF  (CJ  .EQ.  1.)  GO  TO  500  EQST  1 

DPDDJ  *  DPHDD*GF-0.5*PH*EQSTG(MJ)/RhOS(MJ)/(1.+EMU)**2  EQST  1 

DPDE J  =  EQSTG (MJ) *RHOS(MJ)  EQST  1 

CSQ  *  DPDDJ+PJ*DPDEJ/DJ**2+AMU/DJ  EQST  1 

GO  TO  450  EQST  1 

C  EQST  FOR  EXPLOSIVE  (NPR  a  1)  EQSt  1 

400  PJ  a  EQSTG (MJ) *DJ*EJ  EQST  1 

DPDEJaEQSTG (MJ) *DJ  EQST  1 

DPDDJ=EQSTG (MJ) *EJ  EQST  1 

CSQ=EQSTG (MJ) * (EJ+PJ/DJ)  EQST  1 

C  SOUND  SPEED  COMPUTATION  EQST  1 


62 

63 

64 

*5 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 

81 

82 

03 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

00 

01 

02 

03 

04 

05 

06 

07 

08 

09 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 
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SUBROUTINE  EQST  (Concluded) 


450  IF  (CSQ  ,LE ,  0.)  RETURN  $  CQ=CSQ/ ( C J*C J )  EQST  130 

CJ*CJ*!CQ/(CQ*1.)*0.25*!CQ*1.) >  EQST  131 

IF  <CQ  .LT.  0.5  .OR.  CQ  .GT.  2.)  CJ=SQRT!CSQ>  EQST  132 

1005  FORMAT!*  EQST:  EFFECTIVE  VAPORIZATION  ENERGY  HAS  MCCLOSKE Y-THOMPSOEQST  133 
IN  LOG  VARIATION  ABOVE  EQSTE*)  EQST  134 

1007  FORMAT!*  EQST:  EXPONENT  IN  GRUNEISEN  EXPRESSION  =* 1  PE  1 0 . 3 )  EQST  135 

1009  FORMAT!*  EQST A** lPE 1 0 . 3 » *  IS  COEFFICIENT  OF  SECOND  TERM  ASSUMED  INEQST  136 

1  GRUNEISEN  SERIFS  USED  FOR  IMPROVING  EXPANSION  EOS  MODEL*)  EQST  137 

1010  FORMAT!*  MURNAGHAN  HUGONIOT.  CONSTANTS  CHANGED  TO  EQSTC  =  * 1PE 1 0 . 3 * *EQST  138 

It  EQSTD=* 1  PE  1 0  *  3 )  EQST  139 

1020  FORMAT!*  LINEAR  US-UP  HUGONIOT.  CONSTANTS  CHANGED  TO  EQSTC=* 1PE 1 0 • EQST  140 
13.*.  EQSTD=*lPE 10.3)  EQST  141 

1050  FORMAT!*  EXPANSION  PORTION  OF  EQUATION  OF  STATE  IS  INCOMPLETE*)  EQST  142 
1055  FORMAT (»  EXPANSION  EOS  WILL  BE  UNSTABLE  ABOVE  SUBLIMATION  EQST  143 

1  energy  for  chosen  value  of  eqsta*/* -  eqst  144 

2  EQSTN  =  *lPE10.3t*ADDITIONAL  EXPONF.NT  =  *L  1 0 . 3  >  EQST  145 

500  return  eqst  i46 

END  EQST  147 
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SUBROUTINE  EQSTPF 


SUBROUTINE  EQSTPF  < NCALL , I N , M , CJ , 0 , E , P ) 

EQSTPF  COMPUTES  PRESSURE  FROM  A  THREE-PHASE  EQUATION  OF  STATE 
DEVELOPED  BY  PHILCO-FORO.  ROUTINE  HAS  TWO  PARTS  *  ONE  FOR 
READING  AND  INITIALIZING  ANO  THE  OTHER  FOR  COMPUTING  PRESSURE. 

READ  INPUT  <NCALL=0).  CALL  IS  FROM  GENRAT. 

INPUT  -  NCALL *  IN,  M,  ANO  MATERIAL  PROPERTY  CARDS 
OUTPUT  -  PRINTS  CARD  IMAGES,  ORGANIZES  DATA  INTO  ARRAYS 
COMPUTE  PRESSURE  (NCALL=1)  CALL  IS  FROM  HSTRESS  USUALLY 
INPUT  -  NCALL,  M,  CJ»  D«  E 

OUTPUT  -  P  (CURRENT  PHASE  OR  STATE  OF  MATERIAL  IS  AVAILABLE) 

NAMED  COMMON 
REAL  MU, MUM 

COMMON  /EQS/  EQSTA(6) ,EQSTC(6) ,EQSTD(fe) ,EQSTE(6) ,EQSTG(6) , 

1  EQSTH ( 6) »EQSTN<6) ,EQSTS(6> ,EQSTV(6) ,CZQ(6) *CWQ(b) ,C2 (6) 

COMMON  /MELT/  EMELT < 6 , 5 ) « SPH ( 6 ) , THERM ( 6 , 8 ) 

COMMON  /RHO/  RHO ( 6 ) , RHOS ( 6 ) 

COMMON  /TSR/  TSR(6*30) , EXMAT (6*20) , TENS (6, 3) 

COMMON  /Y/  YO (6) ,YA0D(6) *MU(6) ,MUM,YADOM 

DIMENSION  A1 (6) » A2  <6 ) , B (6) , BP (6 ) , Cl ( 6 ) ,CBT(6)  , CC ( 6 ) , C V ( 6 ) , 0 1 ( 6 ) , 

1  DED V ( 6 ) , EBL ( 6 ) ,EBS(6) ,EC(6) ,EtS(6) ,EL0(6) ,E0(6) ,E0V0(6) ,EPSI (6) 

2  EPS2(6) , ESO ( 6 ) ,EV0(6) »HDCT(6) ,PC(6) ,PV0(6) *TM(6) ,VC(6) ,VLO(fe) , 

3  VO(fe) , VSO ( 6 ) , V VO ( 6 ) »WT (6) *Y1 (6) , Y3(6) , ZC (6) ,ZK0(6) ,  ZK I (6 ) , ZK2 ( 6 

4  , ZN ( 6 ) , ZM ( 6 ) 

DATA  ACC,  RI  /l.E-4,  8.3144E7/ 

««****  BRANCH  TO  INITIALIZATION  OR  COMPUTATION  PORTIONS 

IF (NCALL  .EQ.  1)  GO  TO  200 


2 

3 

4 

5 

6 

7 

8 
9 


ERG 

EMU 

Emu 

NC2 


reao  input  data  and  initialize  constants 


Z 1  ,  C 1 ( M ) , DLM , DSM , 0 1 (M) , HLB , HLM ,  HSM 
Z 1  ,  C I  ( M ) , OLM , OSM , D 1 (M)  , HLB  f  HLM , HSM 
INO, IN 

Zl ,HVfa,HVM,TBK,TCK,TMK,WT (M) ,ZKO (M) 
Zl  .HVbtHVM.TBK, TCK.TMK.wT (M) ,ZKO (M) 
IND, IN 


0.)  GO  TO  50 
COMPUTE  -OSM-  IF  UNSPECIFIED 
=  EQSTG (M) *RHOS (M) *ESO (M) 

=  -ERG/ (EQSTC (M) *ERG) 

=  -ERG/ ( EQSTC (M) ♦ (EQSTO(M) *EQSTS ( M) *EMU) *EmU*ERG) 

5  0 


IND  = 

5H 

READ  ( 

IN, 

I  I 

WRITE 

( 6 , 

11 

WRITE 

( 6 , 

11 

READ  ( 

IN, 

11 

WRITE 

( 6 , 

11 

WRITE 

( 6 , 

11 

VO  (M) 

= 

1* 

ESO  (M 

)  =HSM 

I F ( DSM  . 

GT 

40 


42 

44 


C 

50 


60 

C 


EMUO  =  EMU 
NC2*NC2*I 

IF ( NC2  .GT.  20)  GO  TO  42 

P  *  EMU* (EQSTC (M) *EMU» (EQSTD (M) +£MU*EQSTS (M) ) +ERG) *ERG 
PP  =  EQSTC (M) +ERG*EMU* (2.*EQSTD (M) *3.*EMU*EQSTS (M) ) 

EMU  «  EMU-P/PP 

IF  (ABS  (EMU-EMUO)  .GT.  ACC)  GO  TO  <,0 
GO  TO  44 

PRINT  1103, EMUO, P,PP»EMU»M 

STOP  42 

CONTINUE 

VSO(M)  =  VO ( M ) / (EMU* 1 .  ) 

GO  TO  60 

AO JUST  -ESO-  ,  -VSO-  TO  AGREE  WITH  -DSM- 
VSO(M)  =  1 . /DSM 
EMU  =  OSM/RHOS ( M ) - 1 . 

ESO (M)  =  -EMU*(EQSTC(M)+EMU*(EQSTD(M)+EMU*EQSTS(M) ) )/(EQSTG(M)« 
1  RHOS(M)*d,*EMU)  ) 

ELO(M)  e  ESO ( M ) ♦HLM-HSM 

COMPUTE  -DLM-  IF  UNSPECIF l£0 
IF (DLM  .LE.  0.1DLM  =  0.935/VSO(M) 


EQSTPF 
EQSTPF 
EQSTPF 
EQSTPF 
EQSTPF 
EQSTPF 
EQSTPF 
EQSTPF 
EQSTPF lo 
EQSTPF  1 1 
EQSTPF  12 
EQSTPF  1 3 
EQSTPF 1 4 
EQSTC0M2 
EQSTC0M3 
EQST  COM4 
EQSTC0M5 

EQSTC0M6 
EQSTC0M7 
EUSTC0M8 
EQSTC0M9 
EQSTPF 16 
, EQSTPF 1 7 
EQSTPF 18 
) EQSTPF 19 
EQSTPF20 
EQSTPF2I 
EQSTPF22 
EQSTPF  23 
EQSTPF  24 
EQSTPF  25 
EQSTPF  26 
EQSTPF27 
EQSTPF  28 
EQSTPF  29 
EQSTPF30 
EQSTPF31 
EQSTPF  32 
EQSTPF33 
EQSTPF34 
EQSTPF35 
EQSTPF36 
EQSTPF37 
EQSTPF  38 
EQSTPF39 
EQSTPF40 

EQSTPF4 I 

EUSTPF42 
EQSTPF43 
EUSTPF44 
EQSTPF45 
EQSTPF46 
EQSTPF47 
EQSTPF48 
EQSTPF49 
EQSTPF50 
EQSTPF5I 
EQSTPF52 
EQSTPF53 
EQSTPF54 
EQSTPF  55 
EQSTPF  56 
EQSTPF57 
EQSTPF58 
EQSTPF59 
EQSTPF60 
EQSTPF6 1 
EQSTPF  62 
EQSTPF63 
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SUBROUTINE  EQSTPF  (Continued) 


C 


C 


C 


C 

C 

C 

C 


70 


C 


C 


C 


80 


82 

83 

C 


C 


VLO(M)  =  l./DLM 
T  M ( M )  =  TMK/TCK 

TB  a  TBK/TCK 
ELB  *  HVB-HLB 

SOLVE  FOB  -CL-  FROM  EG).  3.21 
CL  =  (HLB-HLM) / (TBK-TMK) 

C V (M )  =  (HVB-HVM)/(TBK-TMK) 

DLTC  =  CV(M)-CL 

SOLVE  FOR  -Al-  .  -A2-  AND  -ALPHA-  FROM  EQS.  3.24 
A 1 ( M )  *  DLTC/R1*WT (M) 

A2(M)  =  (ELB-DLTC'ttTfaK)/(Ri'ttTCK)<,WT  (M) 

SOLVE  FOR  -AR-  FROM  F.Q.  3.25 

X  =  36./TB+6.*TB**6-42. 

AR  =  (A2(M)/TB*A1 ( M) *o . 31 425*X ) / ( 1 . ♦ 0 . 0838*X ) 

A2 (M)  =  A2 (M) -Al (M) 

SOLVE  FOR  -ZC-  FROM  EQ.  3.27 
ZCtM)  =  l./(3.72  +  0.2fe«MAR-7.)) 

SOLVE  FOR  -VC-  FROM  EQ,  3.33 
VC ( M )  =  ( 1 . *Cl (Ml# ( 1 .-TM(M) )**( 1 ,/3. ) *Dl (Ml* (1 ,-TM(M) ) 
SOLVE  FOR  CRITICAL  PRESSURE  -PC-  FROM  EQ.  3.34 
PC  t M )  =  ZC (M)*Ri*TCK/VC (M) /WT (M) 

SOLVE  EQ.  3.6B  FOR  fal  =  BETA*  COMPUTE  B.BP 
B 1  s  3. 

B2  =  1.5*(1./ZC(M)-1.) 

B3  =  2.25/ZC(M)**2-5.5/ZC(M)-0.75 
BO  =  B 1 

B 1  =  B2  +  SQRT (B3-1./B1) 

IF  (ABS( (Bl-BOl/Bl)  .GT.  ACC)  GO  TO  70 
B (M)  =  ( (3.*Bl-6> *Bl-l. )/ (B1*(3.*B1-1.) ) 

BPtM)  =  (Bl-3. ) / (3.*B1-1 . ) 

COMPUTE  -KO-  .  -Kl-  .  AND  -K2-  (EQS.  3.7) 

IF(ZKO(M)  .EQ.  0.)  ZKO(M)  =  Bl 
ZK  1  (M)  =  Bl-ZKO (M) 

ZK2 ( M )  =  (  1 . ♦ ZK 1  (M) +B1-A1  (M)-A2(M) )/2. 

EPS  1 ( M )  =  ZC (M)*TCK*R1/WT (M) 

EPS2 (M)  =  TCK*(CV(M)-R1/WT(M)) 

EO(M)  =  HVB-CV (M) *TBK 

SOLVE  EQ.  3.28  FOR  RV  TO  FIND  EVO*  PVO,  DVO*  WO 
T  =  TM (M ) 

PV  =  EXP(A2(M)*(1.-1./T)*A1 (M)*ALOG(T)) 

X I  =  T/ZC (M) 

A  =  ZKO ( M ) *ZK 1 (M)/T 
AP  =  ZK2 ( M ) * ( T- 1 . /T ) 

SOLVE  EQ.  4.5  FOR  RV 
RV  =  PV/X1 
NC3  =  0 
R V 1  =  RV 
NC3=NC3*1 

IF  (NC3  .GT.  20)  GO  TO  82 
X2  =  1.-(B(M)-BP(M)*RV1)*RV1 
PO  =  X1*RV1/X2- (A*AP*RV1 ) *RV1**2 

POP  =  X1/X2*(X1*RV1»(B(M)-2.*BP(M)#RV1) )/(X2*X2)-(2.*A 
1*RV1 

RV=AMAX1 (RV1+ (PV-PO)/POP. l.E-12) 

IF  (ABS (RV-RVl ) .GT. ACC*RV  .AND.  ABS ( R V-RV 1 ) . GT . 1 . E- 1 2 ) 
GO  TO  83 

PRINT  1 104.RV1 ,PO,POP,RV,M 

STOP  72 

CONTINUE 

SOLVE  EQS.  4.4C*  D*  AND  E  FOR  EV*  RL*  EL 
EV  =  E0(M)>EPS2(M)»T-EPS1 (M)*( (ZK0(M)»2.#ZK1 (M)/T)-ZK2 
RL  *  1 .♦Cl (M)*( 1 ,-T)** ( 1 ./3. ) *01 (M) * ( 1 ,-T) 

EL  =  EV-EPS1 (M)*PV*(1./RV-1./RL)*(A2(M)/T+A1 (M)-l.) 

El  =  EO (M) *ELO (M) -EL 
EVO(M)  =  EV*E1-E0(M) 

PVO(M)  =  PV 
VVO(M)  =  VC(M)/RV 
EO(M)  =  El 

SOLVE  EQ.  4.4D  FOR  -EC-  WITH  T  =  1 .  RV  =  1 
EC ( M )  =  EO (M) +EPS2 (M) -EPSl (M) * (ZKO (M) *2. *ZKl (M)-ZK2(M) 
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GO  TO  80  EQSTPl 1 8 
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EQSTP120 
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EQSTPl 23 
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SUBROUTINE  EQSTPF  (Continued) 


DEDV(M)  =  (ELO(M)-ESO(M) ) / ( VLO < M ) - VSO  ( M ) ) 

EOVO(M)=DEDV (M) 

EES(M)  =  VO(M) *DEDV (M) 

CC ( M )  =  (Ci (M)/Di (M) )«»3/27* 

CSO  *  ESO(M)/(TMK-298. ) 

HDCT(M)  =  0.5* (CL-CSO) *TMK 
CBT(M)  =  0.5*  (CL+CSO)  <>TMK 
EBL(M)  =  ELO(M) -CSO*TMK 
EBS(M)  =  ESO ( M ) -CL*TMK 
Y 1 ( M )  =  2.*CBT (M) 

Y3(M)  =  Yl (M) » (CL-CSO) *TMK 

C  CONSTRUCT  A  FIT  TO  APPROXIMATE  RV-T  RELATION  ON  LV-V  BOUNDRY 

T 1 =T=0 • 95 
NPART  =  5 
GO  TO  650 

100  R 1  =R  V 

T2=T=0.9 
NPART  =6 


GO  TO  650 


105  R2=RV 

ZN (M) x  A LOG ( ( 1 . -R 1 ) / ( 1 . -R2 ) ) / ALOG ( ( 1 .-Tl ) / ( 1 .-T2 ) ) 
Z  M ( M )  =  (l.-Rl)/(l.-Tl)«*ZN(M) 

RETURN 

Q  OOOOOO 

C  CALCULATIONS  TO  FIND  P(V.E) 

c 

c 

c  ***  SELECT  REGION  OF  PHASE  DIAGRAMS 

200  CONTINUE 
V  =  l./D 

C  SELECT  St  SLt  L  OR  Li  LVt  AND  V  REGIONS 

IF  (V  .GE.  VLO(M) )  GO  TO  300 


C  TEST  FOR  COOL  SOLID 

IF  (E  .LE.  ESO(M))  GO  TO  700 
C  ***  SOLVE  FOR  VS  ON  S-SL  BOUNDARY  WITH  ES=E 
Y 2  *  E-EBS(M) 

EZ  =  E 

NPART  =  I  $  GO  TO  600 

C  SECOND  BRANCH  FOR  SOLID  MATERIAL.  CONTINUE  WITH  SL  AND  L 

220  IF  (V  ,LT.  VS)  GO  TO  700 
C  TEST  FOR  COOL  LIQUID 

IF  (E  .LT.  ELO(M) )  GO  TO  750 
C  ***  SOLVE  FOR  TEMP  OF  E  AS  IF  E  IS  ON  SL-L  LINE 
Y  2  =  E-EBL(M) 

TF  =  ( Y2+SQRT (Y2*Y2-Y3(M) ) )/Yl (M) 

C  COMPUTE  ES  FOR  TF 

EZ  *  ES  =  EBS (M) ♦CfaT  <M) *TF *HDCT (M) /TF 
C  GO  TO  600  TO  GET  VS  ON  S-SL  LINE 

NPART  =2  $  GO  TO  602 

C  COMPUTE  VLM  OR  SL-L  LINE 

250  VLM  x  VS* (E-ES) /DEDV ( M ) 

NL  «  I 

C  SEPARATE  SOLID-LIQUID  AND  LIQUID 

IF  (V-VLM)  755. 755. 810 


C 

C  ***  BEGIN  SWITCHING  FOR  L.  LV.  AND  V  REGIONS 

300  IF  (V  .LT.  VC ( M ) )  GO  TO  350 
C  BRANCH  FOR  HIGHLY  VAPORIZED  MATERIAL 

IF  (V  ,GT.  VVO(M) )  GO  TO  900 

C  COMPUTE  EC  t  V )  AT  CRITICAL  TEMP  TO  COMPARE  WITH  E 


ECV  =  EO (M) *EPS2 (M)-EPSI (M) * ( (ZKO (M) +2.*ZKl <M) ) *RV-ZK2  <M) *RV*RV) 
C  SECOND  PARTIAL  ISOLATION  OF  V  FROM  LV  REGION 

IF  (E  .GT.  ECV)  GO  TO  900 

C  COMPUTE  T  AND  THEN  EV  ON  LV-V  LINE  TO  MAKE  THIRD  TEST  FOR 

C  SEPARATING  LV  AND  V 

RV  x  VC  t  M ) / V 

Xl  x  RV/ (ZC (M) * ( I .- (B (M) -BP (M) *RV) *RV) ) -ZK2 (M) *RV**3 
X2  a  -ZKO ( M ) *R V*R V 
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SUBROUTINE  EQSTPF  (Continued) 


X3  *  (ZK2  (M) »RV-ZK1 (M) ) *RV*RV 
TM1N  s  0.0 

IF  (XI  .GT.  0.0  .AND.  X3  .GT.  0.0)  TM1N=SQRT ( X3/X 1 ) 

FMAX  =  (E-ELO(M) )/(EVO(M)-ELO(M) ) 

1 F  (  V  .GT.  FMAX*VVO (M> ♦ ( 1 .-FMAX) *VLO (M) )  GO  TO  990 
T  s  1.0 

PV  =  EXP<A2(M)*(l.-l./T)*Al(M)»AL06(T)) 

NC4*0 

310  PVT  s  PV 
NC4=NC4 ♦  1 

IF  (NC4  .GT.  20)  GO  TO  312 
TA  =  T 

PG  =  X1»T+X2+X3/T 

PVP  =  PV*(A2(M)/T«A1(M))/T 

PGP  a  AMftXl (0. »X1-X3/ (T*T> ) 

T  =  AMAXl (TA+ (PG-PV) / (PVP-PGP) tTMlN+ACC) 

IF  (PVP-PGP  .LT.0.  )  T=TA*0 • 05 
T  =  AM1N1  (1  .  *0.8»TA  +  0. 199) 

PV  =  EXP  (A2 (M> *( l.-l ./T> *A1 (M> »ALOG (T> > 

IF  ( ABS  (  (PV-PVT) /PV)  , GT .  ACC)  GO  TO  310 

EV  =  EO(M> ♦EPS2(M) *T-EPS1 ( M) * ( ZKO ( M ) +2. *ZK 1 (M) /T-ZK2 (M) «KV/T>  *RV 
C  BRANCH  TO  EITHER  V  OR  LV  REGIONS 

IF  (T  .LE.  TM (M) )  GO  TO  985 
IF  (E-EV)  850*900*900 
312  PRINT  1105*TA,PG*PVP.PGP.T*PV*M 
STOP  312 
C 

C  ***  TEST  TO  SEPARATE  L  AND  LV  REGIONS 

C  FIRST  COMPUTE  T  ON  L-LV  LINE.  THEN  EL 

350  NL  *  2 

IF  (E  .GT.  EC (M) )  GO  TO  800 

RL  =  VC ( M ) / V 

Xl  =  (l.-RD/Dl  (M>/2. 

X  =  SORT (X1*X1+CC (M) ) 

T  =  1.- ( ( X-X 1 ) ** ( 1./3. ) - ( X*  X 1 ) ** ( 1./3. ) ) **3 
C  GO  TO  650  TO  OBTAIN  EL 

NPART  =  1 
GO  TO  650 

C  BRANCH  TO  EITHER  L  OF  LV  REGIONS 

375  NL  =  3 

IF  (E-FL) 855.855*800 

C  ******  ***«*« 

C  BUILT-IN  SUBROUTINES 

C  ******  **««*» 

C 

C  ***  SOLVE  FOR  VS  ON  S-SL  LINE. GIVEN  Es-EZ 

600  TF  =  (Y2+SQRT ( Y2*Y2-Y3 (M) ) ) /Y1 (M) 

602  RGE  =  RHOS (M) *EQSTG (M) *EZ 
DEN  =  EQSTC  (M) +RGE 
ENUM  =  EOVO(M)*(TF-l.)-RGE 
EMU1A  =  0. 

EMU1B  =  EMUJA  =  ENUM/DEN 
NC 1  =  0 

605  EMUJ8  =  ENUM/ (DEN+EMU1B* (EQSTD (M) ♦EMU18*EQSTS (M) ) ) 

NCl=NCl *1 

IF  (NCI  .GT.  20)  GO  TO  620 

EMU  =  (EMU1 A*EMUJ8-EMU1B*EMUJA ) / ( EMU J8-EMU J A+EMU I A-EMUIB ) 

IF  (  ABS  (EMU-EMU JB )  .LE.  ACC)  GO  TO  610 

EMU1A  =  EMU1B 

EMUJA  =  EMU JB 

EMU1B  =  EMU 

GO  TO  605 

610  VS  s  l./(RHOS(M)*(EMU+l.) ) 

GO  TO  (220. 250. 805) NPART 
620  PRINT  1106.TF .EZ.M.EMU1A.EMU18 
STOP  620 
C 
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SUBROUTINE  EQSTPF  (Continued) 


C  ***  SOLVE  FOR  P , RL  *  EL  *  RV »  EV  *  ON  LV-V  BOUNORY 
C 

650  Pv»EXP(A2(M>* ( l.-l./T) *A1 (M) »ALOG(T> ) 

Xl=T/ZC (M) 

AxZKO ( M ) ♦ ZK 1 (M)/T 
AP=ZK2 (M) * (T-l ,/T) 

PXxPV/Xl 
8  AX  =  B ( M ) - A/X 1 

IF  (PX*BAX  ,LT.  -0*25  .AND.  NPART  .LT.  5)  GO  TO  653 


EQSTP269 

EQSTP270 

EUSTP271 

EQSTP272 

EUSTP273 

EQSTP274 

EQSTP275 

EUSTP276 

EUSTP277 


RV  =  PX<*  ( 1  ,-PX»BAX) 

IF  (PX*8AX  .LT.  -0.05)  RV»PV/ ( X 1 / ( 1 . ♦ (-B <M > +8P <M ) *RV > *RV > - ( A* 
1 ) *RV> 

GO  TO  654 

653  RV=1.-ZM(M)*(1.-T)**ZN(M) 

654  NC7=0 

655  RV 1  =  RV 
NC7  =  NC7 ♦  1 

IF  (NC7  .GT.  20)  GO  TO  670 
X2  *  l.-(B(M)-8P(M> *RV) *RV 
PO  *  X1*RV/X2- (A*AP#RV) #RV#»2 

POP  =  X1/X2+ ( X1*RV* (B (M) -2.*BP (M) »RV ) ) /X2»»2 
RV  =  AMAX1  (RV+ (PV-PO) /POP, 1 .E-12) 

IF  (ABS (RV-RV1 ) ,GT.ACC*RV  .AND.  A8S ( R V-RV 1 ) . GT 
EV  =  EO(M) *EPS2 (M) *T-EPS1 (M) « ( (ZKO (M) *2.»ZK1 (M 
IF  (NPART  ,GT.  1)  RL  =  1 . * C 1 ( M ) * ( 1 . -T ) ** ( 1 . /3 . 

EL  =  EV-EPS1 (M)*PV* ( l./RV-l./RL)*  (A2(M) /T*A1 (M 
GO  TO  (375,815,875.817» 100, 105)  NPART 
PRINTl 109,RV,RVi ,PV,PO,POP,EV,RL,EL.T,M 
STOP  670 


■  <2.*A  +  3.»AP*RV>  *RV 
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670 

C  ** 
C 

c  ** 
c 

c  ** 

700 


CALCULATIONS  FOR  EACH  PHASE 


►  SOLID  PHASE 

EMU  =  1 . /RHOS ( M ) / V- 1 . 

RGE  *  RHOS (M) »EQSTG (M) *E 

P  *  EMU<HEQSTc(M) ♦EMU»(EQSTD(M) *EMU*EQSTS(M> > *RGE) +RGE 
GO  TO  1000 


C 

C  ** 
750 

C 

755 


SOLID  -  LIQUID  MIXED  PHASE 
FMAX  =  (E-ESO(M) )/(ELO(M)-ESO(M) ) 

IF  (V  .GT.  FMAX»VLO (M) ♦ ( 1 ,-FMAX ) *VSO (M) )  GO  TO  990 

find  t  for  v»  e  in  sl  region 
EPS  =  E-DEDV (M)»V 
ES  =  EPS+DEDV (M) »VS 
Y  2  =  ES-EBS(M) 

TF  *  ( Y2*SQRT (Y2*Y2-Y3 (M) ) ) /Yl (M) 

NC5»0 

760  TFO  x  TF 
NC5=NC5*1 

IF ( NC5  .GT.  20)  GO  TO  780 
ETA  x  VO(M)/VS 
EMU  x  ETA-1. 

ESP  x  CRT (M) -HDCT (M) /TF«»2 
ETAP  x  -ESP*ETA**2/EES (M) 

RGE  =  RHOS(M)«EQSTG(M)*ES 

H  x  E0V0(M)*(TF-1.)-EMU*(EQSTC(M)+EMU»(EQST0(M 
1  ) -RGE 

HP  s  EOVO(M)-(EQSTC(M)*EMU*(2.»EQSTO(M)*EMU*3. 

1  -EQSTG(M)*RHOS(M)  *ETA<*ESP 
TF  x  TF-H/HP 

ES  *  E8S(M)  ♦CBT(M)<>TF*HDCT(M)  /tF 
VS  x  (ES-EPS)/DEDV(M) 

IF  (ABS ( TF-TFO) /TF  .GT.  ACC)  GO  TO  760 
P  x  EOVO(M)*(TF-l.) 

GO  TO  1000 

780  PRINT  1107, TF, TFO, T,M 
STOP  770 


•  1 .E— 12)  GO  TO  655  _ 

) /T ) -2K2 ( M ) *RV/T ) «RVEQSTP292 
>♦01  (M)Mi.-T)  EUSTP293 

)-l.)  EUSTP294 
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SUBROUTINE  EQSTPF  (Continued) 


ON  SL-L  LINE. 


IF 

IF 

IF 

RL 

Xl 

X  a 

T  a 


TO  820 
812 


EL 


812 

C 

c 

c 

815 


C 

C  LIQUID  PHASE 

C  SOLVE  FOR  PLMf  VLM, 

BOO  Y2  =  E-EBL(M) 

TF  =  (Y2*SQRT (Y?*Y2-Y3(M) ) )/Yl <M) 

E7  *  ES  s  EBS(M)*CBT(M)*TF*HDCT<M)/TF 
C  GO  TO  600  TO  GET  VS  ON  S-SL  LINE 

NPART  =  3 
GO  TO  602 

805  VLM=  VS*  (E-ES) /DEDV <M) 

810  PLM  =  EOVO(M)«MTF-l.) 

C  SOLVE  FOR  PLBf  VLB  ON  L-LV  LINE 

(NL  .EQ.  3)  GO  TO  815 
(E  .GE.  EC  (M ) )  GO 
(NL  .EQ.  1)  GO  TO 
=  VC  ( M ) / V 

*  ( 1 .-RL) /D1 (M) /2. 

SQRT(Xl#Xi*CC(M) ) 
l.-(  (X-Xl)«Ml./3.) 

GO  TO  650  TO  OBTAIN 
NPART  =  2 
GO  TO  650 
T  =  TM  < M ) 

EL  =  ELO(M) 

BEGIN  ITERATION  LOOP  TO  FIND  VLB  ON  L-LV  BOUNDR Y  9  GIVEN  E 

TL=T  $  ETL=EL  S  TU=1.0  S  ETU=EC(M) 

TLAST  =  0.5*  ( TU  *TL ) 

USE  PARABOLIC  ESTIMATE  OF  SLOPES  TO  OBTAIN  T  FOR  E 
S2  =  S23=  (TU-TL) / (ETU-ETL) 

IF ( ETL  .NE.  ELO(M) ) 

IS 2  r  (TL-TM(M) ) / (ETL-ELO (M) ) *S23- ( TU-TM <M ) ) / ( ETU-ELO < M ) ) 

T  s  TL+(S2*(S23-S2)ME-ETL)/(ETU-ETL))*<E-ETL> 

TLAST  =  0.5#  ( TU  *  TL ) 

NC8  =  0  S>  NPART  =  4 
NC8-NCS* 1 

I F  {  T  .GT.  TU)  T  =  0. 1*TLAST*0.9*TU 
IF  (T  .LT.  TL)  T=0. 1*TLAST*0.9*TL 
1 F  ( NC8  .GT.  20)  GO  TO  827 

GO  TO  650  TO  COMPUTE  RL»ELiRV»Ev  FOR  GIVEN  T 

GO  TO  650 

IF  (ABS(E-EL)  .LE.  ACC#AMAX 1  { ABS ( E )  » ELO (M ) ) )  GO  TO  819 
S 1 2  =  (T-TL)/ (EL-ETL) 

S23  =  (TU-T)/ (ETU-EL) 

S2  =  S12+S23- (TU-TL ) / (ETU-ETL) 

TLAST  =T 

IF  (EL  .LT.  E)  GO  TO  818 

T  =  TMS2*(S12-S2)*(E-EL)/(ETL-EL))*<E-EL) 

ETU=EL  S  TU=TLAST  %  GO  TO  816 

818  T  =  TMS2MS23-S2)*(E-EL)/(ETU-EL)  )*(E-EL> 

ETL=EL  %  TL=TLAST  %  GO  TO  816 

819  V  LB*=VC(M)/RL 
PLB=PC (M) *PV 
GO  TO  825 

C  SOLVE  FOR  PLB  ABOVE  CRITICAL  POINT  ON  V  =  VC  LINE 

820  VLB  *  VC ( M ) 

RV  =  1. 

Xl  =  E-EO(M)*EPSl(M)*ZKO<M)*RV 

X2  =  EPS1  (M) *  (ZK2 (M) #RV-2.*ZKl (M) ) *RV 

T  s  (Xl*SQRT (X1#X1-4.*EPS2  (M) *X2) ) / <2.*EPS2  (M) ) 

PG  =  RV*T/ (ZC (M) * { 1 ,- <B (M) -BP <M) *RV) *RV) ) - (ZKO <M) *Z«1  (M) /T 
1  (T-1./T)*RV) *RV*RV-PV0(M) 

PLB  =  PC ( M ) *PG 


816 


C 

C 

C 

817 
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SUBROUTINE  EQSTPF  (Continued) 


825 


827 

C 

C  »» 
850 

C 

C 


C 

855 

860 


870 

C 

875 


880 

890 

892 

C 

C  ## 
900 


985 


RM  =  l./VLM 
RB  *  1,/VLB 
Zl  *  (PLM-PLB) / (RM-RB) 

Z2  =  (RB#PLM-RM#PLB)/(RM-RB) 

Pi.  =  Z  1  /V-Z2 

Z3  =  ALOG(PLM/PLB) /ALOGIRM/RB) 

Z  4  =  ( ALOG (RB) »ALOG (PLM) -ALOG (RM) #ALOG (PLB ) ) /ALOG (RM/RB) 

ALP2  =  Z3*AL0G(1./V)-Z4 

F  r  (PLM/ (RM-1 ,/VLO (M) ) -Z3#PLM/RM ) / < Z 1 -Z3#PLM/RM ) 

F  r  AM  1 N 1 (1..AMAX1 (0.,F) ) 

P  =  EXP(F#AL0G(P1) ♦ (1.-F)«aLP2> 

GO  TO  1000 

PRINT  1 110,T,TMIN,TMAX,TU,TL,E,ET,ETL,ETU 
STOP  727 

*  LIQUID-VAPOR  MIXED  PHASE 

RL  =  1  .*C1 (M) *  ( i ,-T) ## ( 1 ,/3. ) +D1 (M) * ( 1 ,-T) 

EL  =  EV-EPS1 <M) #PV* ( 1 ,/RV-l ./RL) # < A2 <M) /T+Al <M) -1 . ) 

CONSTRUCT  UPPER  AND  LOWER  BOUNDS  ON  E,  T 
BEGIN  ITERATION  LOOP  FOR  E  WITH  T  AS  A  PARAMETER 
ETU  =  EV 
GO  TO  860 

ENTER  FROM  375  FOR  V  LESS  THAN  VC 
ETU  =  EL 

ETL  =  (V-VLO(M) )/(VVO(M)-VLO(M) )#<EVO(M)-ELO<M) )*ELO(M) 

FMAX* (E-ELO (M) )/(EVO(M)-ELO(M) ) 

1 F  < V  ,GT.  FMAX«VVO (M) ♦ ( 1 .-FMAX) «VLO <M) )  GO  TO  990 
TU  *  T  $  TL  =  TM ( M ) 

TLAST=0.5*(TU*TL) 

LINEAR  INTERPOLATION  TO  ESTIMATE  T 
NC6  =  0 
NPART=3 

T  a  TL*(E-ETL)#(TU-TL)/(ETU-ETL> 

NC6=NC6+1 

1FINC6  .GT.  20)  GO  TO  892 

IF  (T  .GT.  TU)  T=0. 1 *TLAST ♦ 0 . 8999#TU 

IF  (  T  .LT.  TL)  T  =  0. 1 #TLAST ♦ 0 . 8999«TL 

GO  TO  650  TO  COMPUTE  RL ♦  EL*  RV.  EV  FOR  GIVEN  T 
GO  TO  650 

ET  =  (RL#V-1 . ) / (RL/RV-1 . ) * (EV-EL) *EL 

IF ( ABS (E-ET )  .LE.  ACC# AM AX  1 ( ABS ( E ) ♦ ELO ( M ) ) )  GO  TO  890 
TLAST  =  T 

IF ( ABS ( ET-ETL )  . GT . 1 . )  SI  2= ( T-TL ) / ( ET-E TL ) 

IF  (ABS (ETU-ET)  .GT.  1 . ) S23= ( TU-T ) / (ETU-ET ) 

S2=Sl2+S23- (TU-TL) / (ETU-ETL) 

IF  ( ET  .LT.  E)  GO  TO  880 

T  =  T+ (S2+ (S12-S2)# (E-ET) /(ETL-ET) >  * (E-ET) 

ETU=ET  $  TUaTLAST  $  GO  TO  870 

T=T+ (S2+ (S23-S2)# (E-ET) /(ETU-ET) )#(E-ET) 

ETL=ET  $  TL=TLAST  $  GO  TO  870 
P  =  PC (M) # ( P V-PVO ( M ) ) 

GO  TO  1000 

PRINT  1108,T,TMIN,TMAX,TU,TL,E*ET,ETL*ETU 
STOP  772 

#  VAPOR  PHASE 
. RV  =  VC (M) /V 

Xl  =  E-EO(M) +EPS1 (M)#ZKO(M)#RV 

X2  =  EPSl  (M) # (ZK2 (M) #RV-2.#ZKl (M) ) #RV 

T  =  (X1*SQRT(X1#X1-4.#EPS2(M)#X2) )/(2.*EPS2(M) ) 

P  =  PC(M)#(RV#T/(ZC(M)#(1.-(B(M)-BP(M)#RV)#RV) )-(ZKO(M)*ZKi (M)/T+ 
1  ZK2(M)#(T-1./T)#RV)#RV#RV-PV0(M) ) 

GO  TO  1000 
CONTINUE 
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SUBROUTINE  EQSTPF  (Concluded) 


c 

c 

990 

1000 

1100 

1101 

1102 

1103 

1104 

1105 

1 

1106 

1 

1107 

1108 

1 

1109 

1 

1110 

1 


CUTOFF  AT  ZERO  PRESSURE 

P  *  0. 

RETURN 
FORMAT ( 8 A 1 0 ) 

FORMAT (A10t 1P7E10.3) 

FORMAT <lH*t79Xf5H  IND=A2*5Hf  IN  =  I2 
FORMAT <lH-t*  L0C=42  IN  EQSTPF#5Xf* 

F ORMAT ( 1 H- *  #  LOC  =  82  IN  EQSTPF#5X,# 

FORMAT ( lH-t#  LOC=312  IN  EQSTPF*5X* 

3/1P4E10.3///) 

FORMAT ( 1H-*  *  LOC  =  620  IN  EQSTPF  #5Xf*  T * EZ «M *  EMU  I A , EMU  I B  =  # 1 P5E 1 0 . 
//) 


>♦#  READ  IN  EQSTPF # ) 

E  MUO ♦P»PPfEMU»M=  »1P5E 
RV1  ♦P0fP0P*RVfM  =  <>lP5El 
T A • PG ♦ PVP t PGP tTtPVtMs 


10.3/// 
0.3///) 
*  1 P3E 1 


Format  ( iH-f<*  loc=78o  in  eqstpf  <>5Xf»  tf»tfo»t»m  =*ip4eio. 
FORMAT  ( 1 H- *  #  L0C  =  892  IN  EQSTPF#f5X 
ETU  #1P5E10.3/1P4E10.3///) 

FORMAT ( 1 H - t  #  LOC  =  670  IN  EUSTPF»f5X 
=  #1P5E10.3/1P5E10.3///) 

FORMAT ( 1 H- t  #  LOC  =  827  IN  EQSTPF**5X 
ETU  #1P5E10.3/1P4E10.3///) 

END 


•  #  T  »TMlN*TMAX»TUfTL.E» 
t*  «V»RV1 »PVtPO*POP*EVf 
f*  T  »TMIN*TMAX*TU*TL»E* 


3///) 

ET  *  ETL  * 

RL.EL.T 

ETtETL* 


EOS TP 46 7 
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EQS  TP4  7  0 
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. MEQSTP483 
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SUBROUTINE  ESA 


SUBROUT  INI  ESA ( NC ALL , I N , M , C . D ,E . P , OPDR , DPDE ) 

ROUTINE  COMPUTES  PRESSURE  FROM  SIMPLE  TWO-PHASE  EQUATION  OF  STATE. 
ESA  HAS  TWO  PARTS.  CORRESPONDING  TO  REAOING  AND  COMPUTING 

READ  INPUT  (NCALL=0).  CALL  IS  FROM  GENRAT. 

INPUT  -  NCALL ♦  IN.  M.  MATERIAL  PROPERTY  CARDS 

OUTPUT  -  PRINTS  CARO  IMAGES.  ORGANIZES  OATA  INTO  ARRAYS 


COMPUTE  PRESSURE  (NCALL=1 ) 
INPUT  -  NCALL. M.C.D.E 
OUTPUT  -  C.P.OPDE 


CALL  IS  FROM  HSTRESS  USUALLY. 


NAMED  COMMON 
REAL  MU, MUM 

COMMON  /EQS/  EQST  A  ( 6 )  .  EQSTC  ( 6 )  ♦  EQSTD  ( 6 )  ♦  EQSTt  ( 6  )  » EQSTG  ( 6 )  , 
1  EQSTH  (6)  .EQSTN  (6)  ,  EQSTS  (  6)  »  EQSTV  ( b )  .CZQ  (6)  ,CWQ  (6)  ,C2  (6) 
COMMON  /MELT/  EmElT (6,5) .SPH (6) .THERM (6,8) 

COMMON  /RHO/  RHO ( 6 ) , RHOS ( b ) 

COMMON  /TSR/  TSR(6,30)  .EXMAT (6,20)  .TENS(6,3) 

COMMON  /Y/  YO  (6)  .YADD (6)  »MU (6)  .MUM. YAUDM 

01  MENS  I  ON  B(4,6),F1(6),F2(6),F3(6),F4(6),G1(6),G2(6),G3(6) 
DATA  1 00/ 1 H  / 


IF  (NCALL 
******** 


,EQ.  1)  GO  TO  200 

READ  INPUT  OATA  AND  INITIALIZE  ARRAYS 


******** 


******** 

READ 

WRITE 

WRITE 

READ 

WRITE 

WRITE 


A1,G1(M),F1(M),F2(M),P1,R1,E1 
A1.G1  (M) »F1 (M)  ,F2(M)  .P1.R1.E1 
IDD. IN 

A1 .P2.R2.E2.P3.R3.E3 
A1 .P2.R2.E2.P3.R3.E3 
IDD. IN 

COEFFICIENTS  IN  EXPANSION  EQUATION 


( IN, 1 100) 

(6.1100) 

(6.1121) 

(IN, 1100) 

(6,1100) 

(6,1121) 

INITIALIZE 
RO=RHOS (M) 

F3(M>=(2.*F1 (M)-F2(M) ) /RO 
F4 (M) = (F2 (M) -FI (M) ) /RO/RO 
G2(M)=EQSTG(M)-G1 (M) 

INITIALIZE  -B-  ARRAY 
AO=EQSTC (M) /RO 

A1=P1-R1*E1* (G2 (M) +R 1 *G3 (M) ) -R 1 *E 1 *E 1  * ( F3 ( M ) *R 1 *F4 (Ml  ) 
A2=P2-R2*E2« (G2 (M) *R2*G3(M) ) -R2*E2*E2* ( F3 ( M ) + R2*F4 ( M ) ) 
A3=P3-R3*E3* (G2 (M) +R3*G3 (M) ) -R3°E3*E3* ( F 3 ( M ) +R3*F4 (M) ) 
REDEFINE  A  TO  INCLUDE  DENOMINATORS 
RO=RHOS(M) 


G3 (Ml =G1 (M) /RO 


DO  1 =RO-R 1  $  D02  =  R0-R2  $  D03=RO-R3 

D13=Rl-R3  $  D23=R2-R3 

AO=AO/ (D01*D02*D03)  $ 

A2=-A2/ (002*D02*D12*023>  $ 


D12=R1-R2 


A 1 =  Al/ (D01*D01*D12*D13) 
A3=  A3/(D03*D0 3*013*023) 


B ( 1 ,M) =-A0*Pl*R2*R3-R0*Al*R2*R3-R0*Rl*A2*R3-R0*Rl*R2<>A3 
B ( 2  » M ) =R0*R1* (A2  +  A3) + RO*R2* ( A 1 ♦ A3 ) ♦ R0*R3* ( A 1  +  A2 ) 

1  +R1*R2* (AO  +  A3) +R1*R3* ( AO+A2) *R2*R3* ( AO  +  A 1 ) 

B (3.M) =-RO* (A1  +  A2  +  A3) -Rl* ( A0  +  A2  +  A3) -R2* ( AO  +  A  1 ♦ A3 ) -R3* ( AO+ A  1  +  A2 ) 
.  B  (4 ,M) =A0*A1 +A2  +  A3 
RETURN 

«****»*•»  ******** 

CALCULATION  OF  PRESSURE  AND  SOUNO  SPEED 
********  ******** 

00  If  (D  .LT.  RHOS (Ml)  GO  TO  300 

***  COMPRESSION  EQUATION  OF  STATE 
U=  (D-RHOS (M)  ) /RHOS (M) 

PH=U* (EQSTC (M) +U« (EQSTD (M) *U*EQSTS(M) ) ) 

GG1=EQSTG (M) *U*G1 ( M ) 

GF  = ) .-0.5*U*GG1 
FF=F1 ( M ) *U*F2 ( M ) 
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41 
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SUBROUTINE  ESA  (Concluded) 


P  =  PH*GF  ♦  (GGl«D  ♦  FF»E)*E  ESA 

DPDR  = < (EQSTC <M) ♦U* (2.#EQSTD <M) ♦U»3.»EQSTS <M) ) ) *GF  ESA 

j  -PH* (0.5°EQSTG (M) *U*G1 (M) )  ♦<G1(M)*D  ♦  F2 ( M ) *E ) *E ) /RHOS ( M )  ESA 

2  *GG1*E  ESA 

DPDE  =  GG1 °D  ♦  2.»FF*E  ESA 

GO  TO  350  ESA 

ESA 

«#«  EXPANSION  EQUATION  OF  STATE  ESA 

300  GG3=D»(G2(M) ♦D»G3(M) )  ESA 

FF  =D<MF3(M)+D»F4(M)  )  ESA 

BTERMSsR ( 1 «M) +0* (B <2«M) +0*(B  < 3 *  M ) *0*8 (4.M) ) )  ESA 

P  =  (D-RHOS(M) ) oBTERMS  ♦  ( GG3  ♦  FF*E)»E  ESA 

DPDR  =  (G2(M) ♦2.»D*G3(M)  ♦  ( F  3 ( M ) ♦  2.«D*F4 (M) ) *E) *E  ESA 

1  *BTERMS  ♦  (D-RHOS  <M)  )  *  (B  (2iM)  ♦DM2.»B  (  3«M)  ♦D*3.<>B  (4«M)  )  )  ESA 

DPDE  =  GG3  ♦  2.*FF*E  ESa 

350  CSQ  »  DPDR  ♦  P*DPDE/D*»2  ESA 

IF  (CSQ  .GT.  0.)  C=SQRT (CSQ)  ESA 

RETURN  ESA 

1100  FORMAT(A10*1P7E10.3>  esa 

1121  FORMAT  ( 1 *  79X  » 5H  IND  =  A2«5H»  IN*I2«»  -ESA-*)  ESA 

END  ESA 
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SUBROUTINE  EXPLODE 


SUBROUTINE  EXPLODE  ( NC ALL , I N , M , EHL , DHL , OOLD , PHL , SHL , FBUR , X , J , QH , 

1  TIME*  DTNH ) 

THIS  SUBROUTINE  FOR  DETONATING  FLOW  HAS  THREE  FUNCTIONS  AND 
IS  01  VIDEO  INTO  THREE  CORRESPONDING  PARTS. 

1.  INITIALIZE  THE  MATERIAL  VARIABLES  AT  THE  TIME  OF  REAOING 
MATERIAL  PROPERTIES. 

2.  INITIALIZE  THE  COORDINATE  ARRAYS  TO  SIMULATE  INITIATION. 

3.  COMPUTE  PROGRESS  OF  OETONATION  DURING  THE  CALCULATION. 

NAMED  COMMON 
REAL  MU.MUM 

COMMON  /EQS/  EQST  A  ( 6 )  ,  EQSTC  ( 6 )  ,  EQSTO  ( 6 )  .  EQSTE  ( 6 )  ,  EQSTG  ( f> )  , 

1  EQSTH  (6)  *  EQSTN  ( 6 )  ,EQSTS(6)  ,EGlSTV(6)  ,CZQ(6)  ,CWU<6)  ,C2(6) 

COMMON  /MELT/  EMELT ( 6 . 5 )  . SPH ( 6 )  *  THERM ( 6  *  0 ) 

COMMON  /RHO/  RHO  ( 6 )  . PHOS 1 6 ) 

COMMON  /TSR/  TSR(6*30) .EXMAT (6*20) .TENS (6*3) 

COMMON  /Y/  YO (6) .YADD (6) *MU(6) .MUM.YADDM 

c 

01  MENS  I  ON  BURN (6) .DET(6).0IST(6) .ECJ<6) .PCJ(6) ,QEXPL(6)  ,VCJ(6> 
DIMENSION  EHL ( 1 )  .DHL ( 1 ) .PHL(l) . SHL ( 1 ) . FBUR  ( 1 )  .X(l) 

C 

IF  (NCALL-2)  100*200*300 
C 

C  INITIALIZE  MATERIAL  VARIABLES 

100  REAOtlN.lOOO)Al.QEXPL(M) .BURN ( M ) .OIST(M) 

PRINT  1010.A1 .QEXPL (M) .BURN (M)  .01  ST (M) 

PRINT  1001*  IN 

DET  (M)  =SQRT  (2.*QEXPL  (M)  *EOSTG(M)  *  (EQSTG  (M)  +  2,  )  ) 

EHL ( 1 ) =DET (M) 

VCJ (M) = (EQSTG(M) +1 .  )  /  (  (EQSTG  (M)  *2.  )  *RrtO  ( M )  ) 

ECJ (M) =2.* (EQSTG (M) *1 . ) *QEXPL  <M > / (EQSTG ( M ) +2 . ) 

PCJ (M) =2.*RHO (M) *QEXPL (M) *EQSTG(M) 

IF  (OIST(M)  .EQ.O.)  PRINT  1102*OEXPL(M) 

PRINT  1100* OET (M) , VC J ( M ) .ECJ(M) .PCJ(M) 

1130  FORMAT ( *  AMUR.  HI*  VOCN  =*1P3E10.3> 

RETURN 


EXPL0DE2 
EXPL0DE3 
EXPLOut 4 
EXPLODES 
EXPLOOE6 
EXPLODE7 
EXPLODES 
EXPL0OE9 
EXPLOOlO 
EXPLOw 1 1 
EOSTCOM2 
EGISTC0M3 
EQSTC0M4 
EQSTC0M5 
EQSTCDM6 
EQSTCOM7 
E0STC0M8 
EQSTC0M9 
EXPLO  )  1 3 
EXPLOD  1 4 
EXPLOD1S 
EXPLO 01 6 
EXPLOO 1 7 
EXPLOl)  1 8 
EXPL0D19 
EXPLOD20 
EXPLOl'21 
EXPLOD22 
EXPL0023 
EXPL0D24 
EXPL0025 
EXPL0D26 
EXPL0027 
EXPL0028 
EXPL0029 
EXPLOD30 
EXPL0D31 


C 

C  INITIALIZE  CELL  VARIABLES 

200  CONTINUE 

IF  (DIST(M)  .EQ.  0.)  GO  TO  270 
OX  =  X (J+l ) -X ( J) 

IF  (DX  .LE.  0.)  GO  TO  250 
XH=o.5* (X ( J) +X ( J+l ) ) 

TBURN  =  (ABS (XH-BURN(M) ) -DIST <M ) *DX ) /OET (M) 

IF  (TBURN  .GE.  0.)  GO  TO  250 

FBURN  =  AMIN1 (l.,-TBURN*OET(M)/(DIST(M)*DX) ) 

EHL ( J) =QEXPL (M) ♦ (EC J (M) -QEXPL (M) ) *FBURN 
DHL(J)sRHO(M)/(l.-FBURN<Ml.-VCJ(M)*RHO(M) ) ) 

PHL  ( J)  =SHL  ( J)  =PCJ  (M)  *>FBURN 
FBUR ( J) =FBURN 

250  IF  (FBUR ( J)  ,NE.  0.)  PRINT  1 30 0 . J . M . EHL ( J )  . DHL ( J )  .PHL ( J ) . FBUR ( J ) 
RETURN 

270  EHL ( J)  =  QEXPL ( M ) 

FBUR(J)  =  1.0 

return 

c 

C  COMPUTE  OETONATION  PROCESS- 

300  CONTINUE 

DX=X ( J+l ) -X ( J) 

XH  =  0.5* (X ( J) +X ( J+l ) ) 

DH  =  OHL  t J) 

TBURN  =  (ABS (XH-BURN (M) l-DIST (M)*DX/2.)/DET (M) 

FBURN  =  AMIN1 ( 1 . t  AM AX  1 ( ( T I ME-0 . 5*DTNH-TBURN ) *DET (M ) / <0 1  ST ( M ) *DX)  * 
1  (l,-RHO(M)/DH)/(l,-VCJ(M)*RHO(M) ) ,FBUR(J) ) ) 

IF  (FBURN  .LT.  l.E-3)  RETURN 
HDV  =  O.5*(l./DOLD-1./DH) 

POLD=PHL ( J) 


EXPLO 032 
EXPL0D33 
EXPL0034 
EXPL0D3S 
EXPL0036 
EXPLOD37 
EXPL0D38 
EXPL0039 
EXPLOD40 
EXPLO 041 
EXPL0D42 
EXPL0D43 
EXPLOD44 
EXPL0D45 
EXPL0IJ46 
EXPL0047 
EXPL0D48 
EXPL0D49 
EXPLOOSO 
EXPLODS  1 
EXPL0052 
EXPL0D53 
EXPL00S4 
EXPL0uS5 
EXPL00S6 
EXPLODS7 
EXPLOOS8 
EXPL0059 
EXPLODbO 
EXPL0061 
EXPL0D62 
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SUBROUTINE  EXPLODE  (Concluded) 


PHL<  J)=EQSTG  <M>»DH<MEHL<  J > +POLD*HDV ♦ QEXPL < M > * < FBURN-FBUR <  J)  )  *0H*2 .  EXPL0D63 


1  «HDV) / < 1 ,-EQSTG <M) *HDV*DH)  EXPL0064 

EHL ( J  >  *EHL ( J  > ♦ (PHL  < J>  *POLD> *HDV  +  QEXPL  <M>  * (FBURN-FBUR ( J) ) *2 . *QH«HDVEXPL0065 
PHL ( J) =AMAX1 (PHL ( J) *  PC  J ( M ) *FBURN)  EXPL0U66 

EHL(J)=AHAXl (EHL(J) * EC J ( M ) *F BURN )  EXPL0U67 

FBUR ( J ) =FBURN  EXPL0068 

IF  (FBURN  ,EQ.  1.)  PRINT  1400, J,DH  EXPLOObR 

1400  FORMAT ( *  DETONATION  COMPLETED  FOR  J**I5,*  WITH  DENSITY  =  * 1  PE  1 2 . 4 ) EXPLO J70 
RETURN  EXPLO071 

C  EXPLOL/72 

1000  FORMAT (A10,7E10. 3)  EXPL0073 

1010  FORMAT (A10*1P7E10. 3)  EXPLOD74 

1001  FORMAT (1H*,79X»*  IND=  ,  IN=*I2»*  -EXPLOOE-* , * , ERG/G , CM , 1 /CM* )  EXPL0075 
1100  FORMAT!*  OUTPUT  OF  EXPLODE,  DET  =  * 1  PE  1 0 . 3 , « «  VC J  =  * 1PE 1 0 . 3 1 * ,  ECJEXPL0076 
1=*1PE10.3,*»  PC J=* 1  PE  1 0 , 3 )  EXPL0077 

1102  FORMAT(10X,*EXPLODE-C0NST, VOL. EXPLOSION  WITH  ENERGY  =  * 1  PE  1 0 . 3 , *  ERGEXPLOU78 
j/G*)  EXPL0D79 

1300  FORMAT!*  EXPLODE,  J=*I3»*  M=*I3,*  E=*lPEl0.3»*  D=*F10.6»*  P=*  EXPL0080 

1  1  PE  10,3**  F  =  *F6.3>  EXPL0081 

END  EXPLODb2 
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SUBROUTINE  EXTRA 


SUBROUTINE  EXTRA  EXTRA  2 

EXTRA  3 

ROUTINE  IS  CALLEO  TO  READ  IN  AUXILIARY  INFORMATION  FROM  CARDS  EXTRA  4 

INPUT  -  NONE  EXTRA  5 

OUTPUT  -  ANY  WORDS  IN  COMMON  WHICH  ARE  READ  FROM  THE  EXTRA  CARDS  EXTRA  6 

EXTRA  7 

INTEGER  H, POROUS* PRESS. R I NTER *  SOL  I D *  SPALL  PUFCOM  2 

REAL  MATL»NEM»NET.NEMH.NETH  PUFCOM  3 

MISCELLANEOUS  PUFCOH  4 

COMMON  A2ERO ( 1 ) , CEF , CKS , DA VG , OELT IM , 0 1 SCPT ( 10) * OOLO , DRHO . UTMAX ,  PUFCOM  5 

OTMIN, DTN,OTNH,OU,DX,EOLD,F, FAC, FIRST, J, JCYCS, JINIT,  PUFCOM  6 

JFIN. JREZONI 15) ♦ JSMAX . JST AR , JTS . LSUB ( 30 ) ,M*MAXPR(30) .N.NCYCS,  PUFCOM  7 

NEDIT.NPERN*NR*NREZ0N*NSCRB<6> *NSEPRAT*NSPALL*NTEDT.  PUFCOM  8 

NTEX.NTRI15) *POLD,P6(20>  *  R  ( 30  > *RL AST  * SL AST  * SMAX * TEU I T ( 50 ) *  PUFCOM  9 

TF,TIME*TJ,TREZON,TS,T6(20> *ULAST.U0L0*UZER0.XLAST.XN0W,X0LD  PUFCOM 10 

*  X JDIT ( 20 )  PUFCOM  1  j 

HALFSTEP  VALUES  PUFCOM 1 2 

COMMON  OH*DHLAST*OUH*EH*PH*RH,RHLAST.SH*SHLAST*UH*UHLAST. XH*XHLASTPUFCOM13 


PUFCOM  14 
PUFCOM  15 
PUFC0M16 
PUFCOM 1 7 
PUFCOM 1 8 
PUFCOM 1 9 
PUFCOM20 

COORDINATE  ARRAYS  C00RDC02 

COMMON/COORD/X (200) *X0 (200) *CHL (200) *OHL (200) *DPOO (200) *OPDE (200) .CQ0R0C03 
1  EHLI200) *H (200*3) *NEM( 200) *  NET (200)  *PHL(200) *RHL(200) *SOT(200>  *  COORDCO4 


1 


1 


*NEMH*NETH 

CONDITION  INDICATORS 

COMMON  INF,L INTER* MIRROR  *  NORM AL *  POROUS  *  PRESS  * R I NTER *  SOL  ID, SPALL 
CELL  LAYOUT 

COMMON  DXX ( 30 ) *JBND(30) *JMAT(30>  * NAUTO * M ATL ( 6 * 2 ) * NL A YER . NMTRLS , 
THK (30) 


2  SHL (200) *T(200> *0(200) *YHL(200)*ZHL (200) 

COMMON/NSC/A (5000) 

NAMEO  COMMON 
REAL  MU, MUM 

COMMON  /EOS/  EQSTA (6) ,EQSTC (6) *EQSTO (6) ,EOSTE (6) ,EOSTG (6) , 
1  EGiSTH ( 6 ) ,EOSTN (6) ,EQSTS(6) ,EQSTV(b) ,CZQ(6)*CwQ(6),C2(6) 
COMMON  /MELT/  EMELT ( 6 , 5 ) , SPH ( 6 ) , THERM ( 6 , & ) 

COMMON  /RHO/  RHO  ( 6 > , PHOS ( 6 ) 

COMMON  /TSR/  TSR ( 6 , 30 ) , EXM AT ( 6 , 20 ) , TENS ( 6 ♦ 3 ) 

COMMON  /Y/  Y0(6) *YADD(6) ,MU(6) ,MUM,YAODM 

COMMON  /INO/  IE0SI6) *INDK(20) ,NALPHA,NCMP(6) *NFR(6) ,NP0R(6) 
1  NDS(6) *NPR(6> ,NC0N(6) *NVAR(6) 


C00R0C05 
NSCCOM  2 
EGST  COM2 
EOSTCOM3 
EOSTCOM4 
EQSTC0M5 
EOSTCOM6 
EOSTCOM7 
EOSTCOM8 
EOSTCOM9 


10 


15 


18 


INDCOM  2 
INDCOM  3 

COMMON  /RAD/  SSTOP ( 5 ) , ST ART ( 5 ) ♦ SDURM , SSTOPM , NSPEC , SS J , JSS , I  PLOT ( 4 > R AOCOM  2 
1  ,XMAX(4) ,XMIN(4) ,YMAX(4) ,YMIN(4) *IA(7) ,ITITLE(24) ,NARZ,TARZ  RAOCO”  3 

EXTRA  14 
EXTRA  15 
EXTRA  16 
EXTRA  17 
EXTRA  18 
EXTRA  19 
EXTRA  20 
EXTRA  21 
EXTRA  22 
EXTRA  23 
EXTRA  24 
EXTRA  25 
EXTRA  26 
EXTRA  27 
EXTRA  28 
EXTRA  29 
EXTRA  30 
EXTRA  31 
EXTRA  32 
EXTRA  33 
EXTRA  34 
EXTRA  35 
EXTRA  36 
FXTRA  37 
EXTRA  38 


NAMELIST/NLIST/  DTMAX, JCYCS, JINIT. JF IN, LSUB, MAXPR,NED IT, NSP ALL, 

1  P6*TREZ0N,TS,T6*UZER0, 

2  X,CHL,DHL.DPDD,DPOE,EHL,H,NEM,NET,PHL,RHL,SHL,T,U, yhl.zhl, 

3  JBND* JMAT , NLA YER, 

4  E0STA,EQSTC,E0STD,EQSTE,E0STG,E0STH,EQSTS,E0STV,CZ0,CW0.C2, 

5  EMELT,  RHO , RHOS  *  TSR , EXM AT  ,  TENS ,  Yo*YADD,MU, 

6  NCMP,NFR,NPOR,NOS,NPR,NCON, 

7  SSTOP, START, SOURM 

8  , EOSTN 


I N=5  $  J0=6 

REWIND  7 
NRECeO 

REAO  (IN, 902)  (A(I> 

IF  ( EOF (IN))  19,15 

IF  (All)  .EQ.  2H  S) 


1=1,9) 


GO  TO  18 


( A ( I ) ,1=1,9) 


WRITE  (JO, 902) 

WRITE  ( JO  *  90  1 ) 

WRITE  (7,902)  ( A ( I ) 

IF  (All)  .EQ.  2H  $) 

GO  TO  10 

WRITE  (JO, 902)  ( A ( I )  ,1  =  1 ,9) 
GO  TO  20 


,1=1,9) 
NREC=NREC+ 1 
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SUBROUTINE  EXTRA  (Concluded) 


19  WRITE  (JO, 903) 

20  REWIND  7 

IF  ( NREC  ,LE.  0)  GO  TO  35 
DO  25  NRC*1»NREC 
25  READ  (  7  ,  Nl_  I  ST  ) 

35  CONTINUE 

RETURN 

901  FORMAT (1H*,79X,*  INPUT  FROM  -EXTRA- 

902  FORMAT  ( A2 , A8 » 7  A 1 0 ) 

903  FORMAT!*  EOF  ENCOUNTERED  BY  EXTRA*) 
END 


EXTRA  39 
EXTRA  40 
EXTRA  41 
EXTRA  42 
EXTRA  43 
EXTRA  44 
EXTRA  45 

ROUTINE*)  EXTRA  46 

EXTRA  47 
EXTRA  48 
EXTRA  49 
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SUBROUTINE  FMELT 


SUBROUTINE  FMELT ( LS , M j EN, FM, FG.Xj MSAVE ) 

FMELT 

2 

c 

SUBROUTINE  COMPUTES  THE  THERMAL  STRENGTH 

FMELT 

3 

c 

AND  MODULUS  REDUCTION  FACTORS  FM  AND  FG 

FMELT 

4 

c 

LS  =  -1  INITIALIZE  FOR  NOMINAL  VALUES  OF  FMELT  AND  GMELT 

FMELT 

5 

c 

0  INITIALIZE  FOR  STRENGTH  (FM) 

FMELT 

6 

c 

1  INITIALIZE  FOR  MODULUS  (FG) 

FMELT 

7 

c 

2  COMPUTE  FOR  STRENGTH 

FMELT 

8 

c 

3  COMPUTE  FOR  MODULUS 

FMELT 

9 

c 

4  COMPUTE  FOR  BOTH  STRENGTH  AND  MODULUS 

FMELT 

10 

c 

M  MATERIAL  NUMBER 

FMELT 

1  1 

c 

EN  DIMENSIONAL  ENERGY 

FMELT 

1  2 

c 

X  INPUT  ARRAY  FOR  INITIALIZING  PARAMETERS 

FMELT 

1  3 

c 

ZERO  TO  3  PARABOLIC  REGIONS  MAY  BE  USED 

FMELT 

14 

c 

INPUT  VALUES 

FMELT 

1  5 

c 

NO.  1  2345678 

FMELT 

1  6 

c 

ZERO  MELT 

FMELT 

1  7 

c 

ONE  MELT  DF 1 

FMELT 

1  8 

c 

TWO  MELT  El  DF1  FI  DF2 

FMELT 

19 

c 

THREE  MELT  El  DF1  FI  E2  DF2  F2  DF3 

FMELT 

20 

DIMENSION  E ( 6, 6 ) j  F( 6j 1 8 ) J NREG ( 6 , 2 ) , X ( 7 ) 

FMELT 

21 

IF  (LS.GT.  1 )  GO  TO  200 

FMELT 

22 

IF  (LS  .  GE.  0)  GO  TO  30 

FMELT 

23 

LS  =  NREG(MJ  1  )=NREG(MJ  2)  =  0 

FMELT 

24 

X ( 1 ) =EN  $  X ( 2) =0 . 35  S  X(3)=0.15  S  X(4)=0.25  $  X(5)=-0.06 

FMELT 

25 

X ( 7 ) =0 . 

FMELT 

26 

30 

IF  (MSAVE  .EQ.  M)  GO  TO  150 

FMELT 

27 

c 

INITIALIZE  IN  REGION  1 

FMELT 

28 

50 

EN  =  X ( 1 ) 

FMELT 

29 

IF  (X(1)  .GT.  0.  .AND.  (X(2)  ,NE.  0.  .OR.  X(4)  .NE.  0.)) 

FMELT 

30 

1  GO  TO  60 

FMELT 

31 

E (M j 1+LS*3)=X(1 ) 

FMELT 

32 

NREG ( M j LS+1 )=-1 

FMELT 

33 

RETURN 

FMELT 

34 

60 

NIN  =  9  *LS 

FMELT 

35 

IF  ( X ( 4 )  .NE.  0. )  GO  TO  100 

FMELT 

36 

NR  =  1 

FMELT 

37 

F (Mj 1+NIN)  =  1  . 

FMELT 

38 

F (Mj 2+N I N )  =  ( - 1  . +4. #X(2) )/X( 1  ) 

FMELT 

39 

F  (Mj 3+NIN) a -4. *X(2)/X( 1 )##2 

FMELT 

40 

E (Mj 1 +3#LS )  =  X(1 ) 

FMELT 

41 

NREG ( M j  LS  +  1  )=1 

FMELT 

42 

IF  ( ABS (X ( 2 ) )  .GT.  0.251)  GO  TO  500 

FMELT 

43 

RETURN 

FMELT 

44 

100 

NR=  1 

FMELT 

45 

IF  ( X ( 2 )  .LT.  1.  )  X(2)=X(2) #X( 1 ) 

FMELT 

46 

F ( M j 1+NIN)  =1. 

FMELT 

47 

F ( M j 2+NIN)  = ( X ( 4 ) - 1 .  +4. #X(3))/X(2> 

FMELT 

48 

F ( M j 3+NIN)  =-4. #X(3)/X(2)##2 

FMELT 

49 

E ( M j 1 +LS#3 )  =  X(2) 

FMELT 

50 

NIN  =  NIN+3 

FMELT 

51 

IF  ( X ( 7 )  .NE.  0)  GO  TO  120 

FMELT 

52 

NR  =  2 

FMELT 

53 

C 

INITIALIZE  IN  REGION  2 

FMELT 

54 

F (M , 1+NIN)  =X(4)-X(2)/(X(1 )-X(2))#(-X(4)+4.#X(5)#X(1 )/ 

FMELT 

55 

1  ( X ( 1  )  -  X ( 2)  )  ) 

FMELT 

56 

F ( M j 2+NIN) =( -X(4)+4. *X ( 5 ) * ( X ( 2 ) +X ( 1 ) ) / (X ( 1 ) -X ( 2 ) ) ) / ( X ( 1 ) -X ( 2 ) ) 

FMELT 

57 

F ( M j 3+N I N ) = -4 . *X(5)/(X(1 ) -X(2) )*#2 

FMELT 

58 

E ( M j 2+LS#3 )  =  X ( 1 ) 

FMELT 

59 

NREG ( M j  LS  +  1 )  =  2 

FMELT 

60 

IF  ( ABS ( X ( 5 ) )  .GT.  0.25  *  X(4)+l.E-4)  GO  TO  500 

FMELT 

61 

IF  ( ABS ( X ( 3 ) )  .GT.  0 . 25* ( 1 . -X(4 ) ) +1 . E-4 )  GO  TO  500 

FMELT 

62 

RETURN 

FMELT 

63 

120 

NR  =  2 

FMELT 

64 

IF  ( X ( 5 )  .LT.  1.)  X ( 5 )  =  X ( 5 )  *X(1) 

FMELT 

65 

F ( M j 1 +N I N ) =  X(4)-X(2)/(X(5)-X(2))«(X(7)-X(4)  +4  .  *X  (  6  )  /  ( X  (  5 )  -X  (  2 )  > 

FMELT 

66 

1  *X  ( 5 ) ) 

FMELT 

67 

F ( M j 2+NIN) =  (X(7) -X(4)+4 . *X(6)*(X(5)+X(2) )/(X(5)-X(2) ) )/ 

FMELT 

68 

1  (X(5)-X(2) ) 

FMELT 

69 

F ( M  j 3+N I N )  =  -4 . *X(6)/(X(5)-X(2) )  **2 

FMELT 

70 

E ( M j 2+LS*3) =X(5) 

FMELT 

71 

E ( M j 3+LS*  3 )  =  X ( 1 ) 

FMELT 

72 

MSAVE  =  M 

FMELT 

73 

X7  =  X ( 7 ) 

FMELT 

74 

X5  =  X ( 5 ) 

FMELT 

75 

IF  ( ABS ( X ( 6) )  .GT.  0.25  #(X(4)-X(7))+1 .E-4)  GO  TO  500 

FMELT 

76 
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SUBROUTINE  FMELT  (Concluded) 


c 

150 


200 


250 


255 

260 

265 

275 

260 


300 

310 

320 

C 

350 


355 

360 

365 

375 

380 


400 
500 
1  500 


IF  ( ABS ( X ( 3 ) )  .GT.  0 . 25* ( 1 . -X(4 ) )+1 . E-4)  GO  TO  500 

FMELT 

77 

RETURN 

FMELT 

78 

INITIALIZE  FOR  THE  THIRD  REGION 

FMELT 

79 

NR  =  3 

FMELT 

80 

NIN  =  9#LS  +  6 

FMELT 

81 

EM  =  E ( M , 3+LS#3 ) 

FMELT 

62 

F ( M ,  1+NIN)  =  X7-X5/CEM-X5) #( -X7+4 , #X(  1  ) *EM/ ( EM-X5) ) 

FMELT 

83 

F ( M , 2+NIN)  =  ( -X7+4. *X( 1 ) * ( EM+X5 ) / ( EM-X5 ) )/(EM-X5) 

FMELT 

84 

F ( M, 3+N I N )  =  -4 . *X( 1 ) / ( EM-X5) ##2 

FMELT 

85 

NREG ( M , LS+ 1 )  *  3 

FMELT 

86 

MSAVE  =  0 

FMELT 

87 

IF  ( ABS ( X ( 1 ) )  .GT.  0.25  *X7+1.E-4)  GO  TO  500 

FMELT 

88 

RETURN 

FMELT 

89 

####*#**#####*####*# 

FMELT 

90 

COMPUTATION  OF  STRENGTH  REDUCTION  FUNCTION,  FM 

FMELT 

91 

CONTINUE 

FMELT 

92 

IF  (LS  . NE.  3)  GO  TO  250 

FMELT 

93 

IF  ( NREG (Mj  2)  .NE.  0)  GO  TO  350 

FMELT 

94 

NN  =  NREG(M, 1 ) 

FMELT 

95 

IF  (NN  .LE.  0  .AND.  EN  .LT.  E(M,1))  GO  TO  255 

FMELT 

96 

IF  (EN  .GT.  0. )  GO  TO  260 

FMELT 

97 

FM  =  1  .  0 

FMELT 

96 

GO  TO  300 

FMELT 

99 

IF  (NN  .LE.  0  )  GO  TO  265 

FMELT 

1  00 

IF  (EN  .LT.  E (M, NN) )  GO  TO  275 

FMELT 

101 

FM  =  0. 

FMELT 

1  02 

GO  TO  300 

FMELT 

1  03 

N  =  0 

FMELT 

104 

N  =  N  +  1 

FMELT 

105 

IF  (EN.GE.  E ( M , N )  .AND.  N  .LT.  NN)  GO  TO  280 

FMELT 

1  06 

NIN  ■  3  *  (N-1 ) 

FMELT 

107 

FM  =  F  ( M ,  1 +N I N )  +  (  F  (  M , 2+N I N )  +  F ( M , 3+N IN)*EN)*EN 

FMELT 

1  08 

IF  (LS  -  3  )  400,  320,  310 

FMELT 

1  09 

IF  ( NREG ( M, 2 )  . NE .  0  )  GO  TO  350 

FMELT 

1  1  0 

FG  =  FM 

FMELT 

1  1  1 

GO  TO  400 

FMELT 

1  1  2 

COMPUTATION  OF  MODULUS  REDUCTION  FUNCTION,  FG 

FMELT 

1  1  3 

NN- NREG ( M , 2) 

FMELT 

1  14 

IF  (NN  .LE.  0  .AND.  EN  . LT .  E(M,4))  GO  TO  355 

FMELT 

1  15 

IF  (EN  .GT.  0. )  GO  TO  360 

FMELT 

1  16 

FG  =  1 . 0 

FMELT 

1  1  7 

GO  TO  400 

FMELT 

1  1  8 

IF  (NN  .LE.  0)  GO  TO  365 

FMELT 

1  19 

IF  (EN  .LT.  E ( M , NN+3 ) ) GO  TO  375 

FMELT 

1  20 

FG  =  0. 

FMELT 

121 

GO  TO  400 

FMELT 

1  22 

N  =  0 

FMELT 

1  23 

N  =  N+1 

FMELT 

124 

IF  (EN  .GE.  E ( M, N+3 )  .AND.  N  . LT .  NN)  GO  TO  380 

FMELT 

1  25 

NIN  =  3# ( N- 1 ) +9 

FMELT 

126 

FG  =  F(M, 1+NIN)+(F(M, 2+NIN)  +F(M,3+NIN)  *  EN)  *EN 

FMELT 

127 

RETURN 

FMELT 

126 

PRINT  1500,  NR 

FMELT 

1  29 

FORMAT  ( 33H0ERR0R  IN  FMELT,  SLOPE  IN  REGION  13, 

FMELT 

1  30 

I  51 H  IS  POSITIVE  BECAUSE  CURVE  OFFSET  EXCEEDS  (F1-F2)/4) 

FMELT 

131 

RETURN 

FMELT 

1  32 

END 

FMELT 

1  33 
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c 
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SUBROUTINE  GENRAT 

READS  INPUT  DATA  AND  INITIALIZES  ARRAYS 

*  READS  INPUT  CARDS,  EXCEPT  FOR  RADIATION  INFORMATION 

*  COMPUTES  COORDINATE  LAYOUT 

*  INITIALIZES  DENSITY,  ENERGY,  YIELD,  SOUND  SPEED,  SPALL 

STRENGTH,  CONDITION  INDICATORS,  PARTICLE  VELOCIY 

*  PRINTS  INITIAL  LAYOUT  FOR  NON - RAD  I  AT  I  ON  PROBLEMS 

I NTEGER  H, POROUS, PRESS , R I NTER, SOLI D, SPALL 
REAL  MATL, NEM, NET, NEMH,  NETH 
MISCELLANEOUS 

COMMON  AZEROC 1  ) , CEF, CKS, DAVG, DELTIM, DISCPTC 1 0)  ,  DOLD,  DRHO ,  DTMAX, 

1  DTMI N, DTN , DTNH, DU, DX, EOLD, F, FAC, F I RST, J , JCYCS,  J I N I T, 

2  JF I N , JREZON (15), JSMAX, JSTAR, JTS, LSUB ( 30 ) , M , MAX PR ( 30 )  ,  N,  NCYCS, 

3  NEDI T, NPERN , NR, NREZON, NSCRB ( 6 ) , NSEPRAT, NSPALL,  NTEDT, 

4  NTEX , NTR (15), POLD, P6 ( 20 ) , R ( 30 ) , RLAST, SLAST, SMAX,  TED  I  T( 50 )  , 

5  TF, TIME, TJ, TREZON, TS, T6(20) , ULAST, UOLD, UZERO, XLAST, XNOW, XOLD 

1  , X JD I T ( 20 ) , MS 

HALFSTEP  VALUES 

COMMON  DH , DHLAST, DUH, EH, PH, RH , RHLAST, SH , SHLAST,  UH,  UHLAST,  XH,  XHLAST 
1  , NEMH, NETH 

CONDITION  INDICATORS 

COMMON  I NF, LI NTER, MI RROR, NORMAL , POROUS, PRESS , R I NTER,  SOLID,  SPALL 
CELL  LAYOUT 

COMMON  DXX ( 30 ) , JBNDC30) , JMATC30) , NAUTO , MATL ( 6 , 2 ) , NLAYER, NMTRLS , 

1  THKC30) 

NAMED  COMMON 
REAL  MU, MUM 

COMMON  /EQS/  EQSTA ( 6 ) , EQSTC ( 6 ) , EQSTD ( 6 ) , EQSTE ( 6 ) , EQSTG  C  6 )  , 

1  EQSTH ( 6 ) , EQSTN ( 6 ) , EQSTS ( 6 ) , EQSTV ( 6 ) , CZQ (  6 )  , CWQ ( 6 )  ,  C2 ( 6 ) 

COMMON  /MELT/  EMELT ( 6, 8 ) , GMELT (6, 8) ,SPH(6) , THERM ( 6,8) 

COMMON  /RHO/  RHO ( 6 ) , RHOS ( 6 ) 

COMMON  /TSR/  TSR( 6, 30) , EXMATC 6, 20) , TENSC 6, 3) 

COMMON  /Y/  YO ( 6 ) , YADD ( 6 ) , MU ( 6 ) , MUM, YADDM 
COORDINATE  ARRAYS 

COMMON/COORD/X ( 200 ) , X0( 200) , CHL(200) , DHL ( 200 ) , DPDD( 200) , DPDEC200)  , 

1  EHL ( 200 ) , H ( 200, 3 ) , NEM (200) , NET ( 200 ) , PHLC200) , RHL ( 200 ) , SDT ( 200 )  , 

2  SHLC200) , TC200) , UC200) , YHLC200) , ZHLC200) 

COMMON/NSC/A ( 5000 ) 

COMMON  /JED/JEDI T( 100) , JNUMC 100), JTYPC 100) , NAME2 ( 40 )  ,  JEDSI  Z, 

1  MODLUS, NERR, NJEDI T, NTAPE 

COMMON  /IND/  I EOSC  6) ,  I NDKC  20) , N ALPHA, NCMPC  6) , NFR(6),NP0R(6) , 

1  NDSC6) , NPRC6) , NC0NC6) , NVARC6) 

COMMON  /RAD/  SSTOP ( 9 ) , START ( 9 ) , SDURM, SSTOPM, NSPEC, SSJ, JSS,  I  PLOT ( 4 ) 
1  , XMAX ( 4 ) , XM I N ( 4 ) , YMAX (4),YMINC4),1AC7),ITI TLE ( 24 ) , NARZ , TARZ 

COMMON  /PES/  LVMAX, LVTOT, LVAR ( 200 ) , COM ( 4000 ) 

COMMON  /ESC/  ESC ( 6 , 20 ) 

DIMENSION  DELFI N(30, 5) , DELX (30,5), THC30, 5) , NCELLS ( 30, 5 )  ,  NZO 
INTEGER  HH 

EQUIVALENCE  ( DELF I N, H ( 1 )), (DELX, H (151 ) ) , ( TH , H ( 301 ) ) , 

1  (NCELLS, H( 451 ) ) , ( NZONES , H ( 60 1 ) ) 


GENRAT 

GENRAT 

GENRAT 

GENRAT 

GENRAT 

GENRAT 

GENRAT 

GENRAT 

GENRAT 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

EQSTCOM 

EQSTCOM 

EQSTCOM 

EQSTCOM 

EQSTCOM 

EQSTCOM 

EQSTCOM 

EQSTCOM 

COORDCOM 

COORDCOM 

COORDCOM 

COORDCOM 

NSCCOM 

JEDCOM 

JEDCOM 

I NDCOM 

I NDCOM 

RADCOM 

RADCOM 


FORMAT  ( 1H1 , 1 0A1 0/ / 

1  J  DX  X(J)  U(J)  YHLCJ)  CHL(J)  DHL ( J ) 

2  T ( J )  ZHL(J)  EHL(J)  MATERIAL  COND  J 

3  / 1 02H  CM  CM  CM/SEC  DYN/CM2  CM/SEC 

4M3  DYN/CM2  GM/CM2  ERG/GM  ) 

17  FORMAT ( 14, 1 P9E1 0 . 3, 2X, A9, 3R2, 15) 

18  FORMAT ( 29H  TIME  TO  COMPLETE  GENRAT  IS  F10.3,9H  SECONDS.) 

19  FORMAT (A4,A5, IX, 1P7E10.3) 

1019  FORMAT ( A4, A5, 1 X, 7E1 0 . 3) 

1020  FORMAT (A10,7E10.3) 

1021  FORMAT (2CA10, E10. 3) , A10, I10,A10,E10.3) 

1025  FORMAT ( 2 ( A1 0 , I10),2(A10,E10.3)) 

20  FORMAT ( A 1 0, 1 P7E1 0 . 3, A5, A2, A5, I2,3A10,A7) 

21  FORMAT ( 2 ( A 1 0,  1  PEI  0 . 3 ) , A1 0,  M 0, A1 0, 1  PEI  0 . 3, A5, A2, A5,  I  2, 3A1 0, A7 ) 

22  FORMAT (A10, 1 4  I  5, A5, A2, A5,  I  2, 3A1 0, A7 ) 

23  FORMAT ( 4 ( A 1 0,  I  1 0) , A5, A2, A5,  I  2, 3A1 0, A7) 

24  FORMAT  (10A1) 

25  FORMAT ( 2 ( A 1 0,  I  1 0 ) , 2 ( A 1 0 , 1  PE  1 0 . 3 ) , A5, A2, A5,  I  2, 3A 1 0, A7 ) 


2 

3 

4 

5 

6 

7 

8 
9 

10 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1  1 
12 

13 

14 
1  5 
1  6 
17 
1  8 
1  9 
20 

2 

3 

4 

5 

6 

7 

8 
9 
2 

3 

4 

5 
2 
2 
3 
2 
3 
2 
3 


GENRAT 

18 

GENRAT 

19 

GENRAT 

20 

(30) 

GENRAT 

21 

GENRAT 

22 

GENRAT 

23 

GENRAT 

24 

GENRAT 

25 

GENRAT 

26 

GENRAT 

27 

1  3 1  H 

GENRAT 

28 

GENRAT 

29 

, 

GENRAT 

30 

GM/C 

GENRAT 

31 

GENRAT 

32 

GENRAT 

33 

GENRAT 

34 

GENRAT 

35 

GENRAT 

36 

GENRAT 

37 

GENRAT 

38 

GENRAT 

39 

GENRAT 

40 

GENRAT 

41 

GENRAT 

42 

GENRAT 

43 

GENRAT 

44 

GENRAT 

45 
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26 

FORMAT (A1 , R9, 7A1 0, A5, A2, A5, 12, 3A10, A7) 

GENRAT 

27 

FORMAT ( 1 H+, 79X, A5, A2, A5, I 2, 3A1 0, A7) 

GENRAT 

30 

FORMAT  (8A10) 

GENRAT 

31 

FORMAT  ( 1  HI , 25X, 26H****  SRI  PUFF  8  ***#  /) 

GENRAT 

41 

FORMAT  ( 1  HI ) 

GENRAT 

50 

FORMAT  !  A 1  0, *  BOUNDARY  AT  *A5,  *  SURFACE*) 

GENRAT 

1  062 

FORMAT !  2A4,  I 2,  I 1 0, 3!2A5, El  0. 3) ) 

GENRAT 

1  064 

FORMAT ( 2A5,  I 1 0, 3 ( 2A5 , El  0 . 3 ) ) 

GENRAT 

1073 

FORMAT  ( 2  ( A1  0,  I10),A10,E10.  3,  A1  0,1011) 

GENRAT 

1075 

FORMAT! 8E1 0.3) 

GENRAT 

1090 

FORMAT ( A1 , A9, 2A1 0, El  0 . 3,  2 ( A7,  3 1  1  )  ,  A7,  I 3, A8,  I 2 ) 

GENRAT 

62 

FORMAT ( 2A4,  12,  I 10,3(2AS, 1  PE 1 0 . 3 ) , A5 , A2, A5 ,  I2,3A10,A7) 

GENRAT 

64 

FORMAT ( 2A5,  I10,3(2A5, 1  PEI  0 . 3 ) , A5, A2, A5,  I2,3A10,A7) 

GENRAT 

66 

FORMAT (A10, I 1 0 , A 1 0 , 1 0 I 5, A5, A2 , A5, I 2, 3A 1 0, A7 ) 

GENRAT 

67 

FORMAT ( 86H0  ****  ABORT  FOLLOWING  LINE  DOES  NOT  FIT  YIELD,  MELT, 

GENRAT 

1 V I SCOS I TY,  OR  SPALL  CATEGORI ES/8A1 0) 

GENRAT 

69 

FORMAT!  ) 

GENRAT 

73 

FORMAT! 2! A1 0,  110), A1 0, 1  PE 10.3, A10, 1011) 

GENRAT 

75 

FORMAT! 1 P8E1 0. 3) 

GENRAT 

80 

FORMAT ! 1  OX, 1415) 

GENRAT 

90 

FORMAT !A1 , A9, 2A1 0, 1  PEI  0 . 3, 2 ! A7, 3 1 1 )  ,  A7,  I 3, A8,  I 2, A5, A2, A5,  I 2, 3A1 0, 

GENRAT 

1  A7 ) 

GENRAT 

96 

FORMAT  ! 31 H  ERROR  JFIN  EXCEEDS  301,  JFIN=I4) 

GENRAT 

C 

GENRAT 

97 

FORMAT  ! *  1  DATA  BANK  WITH  HEADING  --  *A10,*--  ON  FILE* 

GENRAT 

1  12/) 

GENRAT 

98 

FORMAT  (*0  DATA  BANK  WITH  HEADING  --  *A10,*--  ON  FILE*I2/) 

GENRAT 

100 

DO  101  1=1,456 

GENRAT 

101 

AZERO ( I)=0. 

GENRAT 

DO  103  1=1 ,4000 

GENRAT 

1  03 

X  (  I  )  =  0  . 

GENRAT 

DO  105  1=1,5000 

GENRAT 

1  05 

A ( I ) =0 . 

GENRAT 

DO  109  1=1,72 

GENRAT 

1  09 

EQSTAC I ) =0. 

GENRAT 

DO  111  1=1,150 

GENRAT 

1  1  1 

EMELTC I ) =0 . 

GENRAT 

DO  113  1=1,318 

GENRAT 

1  13 

TSRC I ) =0. 

GENRAT 

DO  115  1=1,18 

GENRAT 

1  15 

YOC I ) =0 . 

GENRAT 

DO  117  1=1,26 

GENRAT 

1  17 

I  EOS ( I  ) =0 

GENRAT 

DO  119  1=1,23 

9/12/79 

1  1  9 

SSTOP ( I ) =0. 

GENRAT 

LVTOT  =  4000 

GENRAT 

LL=LVT0T+200 

GENRAT 

DO  121  1=1, LL 

GENRAT 

121 

LVARC I ) =0 

GENRAT 

JSMAX= 1 

GENRAT 

CALL  SECONDC FIRST) 

GENRAT 

LI NTER  =  5R  L  $  NORMAL2  5R  N  $  POROUS  =  PRESS= 5R  P 

GENRAT 

M I RR0R=5R  M  $  R I NTER=5R  R  S  SOLID  =SPALL=5R  S 

GENRAT 

I NF=5R  I 

GENRAT 

AHEAD  =  9HHEAD I NG  $  BHEAD= 1 H  $  D I SCPT ( 1  )  =  1  OH  DATE  = 

GENRAT 

1 

I DD= 1 H  S  N I ND=5H  I ND=  $  NIN=5H,  I N= 

GENRAT 

1 

NAT= 1 0H  SEC  $  NBT  = 1  OH  ,  ,  ,  CM,  $  NCT=10H  ,  ,  ,  CM/ 

GENRAT 

1 

NDT= 1 OHSEC  $  N5T  = 1  OH  G/CM3  $  NFT  = 1  OH  DYN/CM2,  = 

GENRAT 

1 

NGT= 1 0H,  ERG/G,  ,  $  NHT  = 1 0H  ,  DYN/CM2  $  NIT=10H,  ERG/G 

GENRAT 

1 

N JT= 1  OH  DYN/CM2 ,  $  NKT  = 1  OH  ERG/G,  $  NLT= 1  OH  CM,  CM, 

GENRAT 

1 

IN  =  5  $  OUT  =  6 

GENRAT 

1 

CALL  DATE ( D I SCPT ( 2 ) ) 

GENRAT 

1 

C 

GENRAT 

1 

C 

####  READ  AND  PRINT  DATA  **** 

GENRAT 

1 

C 

GENRAT 

1 

152 

READ  (5,30)  (ITITLE(I), 1=1,8) 

GENRAT 

1 

C 

CHECK  FOR  END  OF  LAST  DATA  DECK 

GENRAT 

1 

IF  ( EOF ( 5 ) )  153,154 

GENRAT 

1 

1  53 

STOP  70001 

GENRAT 

1 

1  54 

IF  CITITLEM)  .NE.  5H  DATA  .AND.  ITITLE(I)  .  NE .  9H  ABS  DATA)  GO  TO 

GENRAT 

1 

1 

157 

GENRAT 

1 

J0  =  4 

GENRAT 

1 

IF  (ITITLE(I)  . EQ .  9H  ABS  DATA)  J0=2 

GENRAT 

1 

IF  (ITITLEC2)  .EQ.  IDD)  PRINT  98 , I T I TLE ( 1 ) , JO 

GENRAT 

1 

IF  ( I T I TLE ( 2 )  .NE.  IDD)  PRINT  97, I T I TLE ( 1 ) , JO 

GENRAT 

1 
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46 

47 

46 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 

61 

62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 

81 

82 

83 

84 

85 

86 

87 

88 

2 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

00 

01 

02 

03 

04 

05 

06 

07 

08 

09 

1  0 

1  1 

12 

13 

14 

15 

16 

17 

1  8 

1  9 

20 
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SUBROUTINE  GENRAT  (Continued) 


155  READ  (5J30)(A(I)J 1=1,8) 

IF  CE0FC5) )  1 52, 156 

156  WRITE  (J0J30)(A(I)JI=1J8) 

IF  CITITLEC2)  . NE .  IDD)  WRITE  (6,30)  CACI>JI=1J8) 

GO  TO  155 

157  DECODE  (80,26, ITITLE)  IND, ( D I SCPT (11,1=3,10) 

WRITE  (6,  31  ) 

WRITE  (6,30)  D I SCPT (1 ) , D I SCPT ( 2 ) 

WRITE  (6,26)  IDD,  (DISCPT( I ) ,  I =3, 1 0 )  ,  N I ND,  I  ND,  N  I  N ,  I  N 
I  N  =  5 

I F  ( I ND  . EQ,  I DD)  GO  TO  1 58 
IF  (  IND  .EQ.  1  HD )  GO  TO  190 
C  ACTIVATE  PROCEDURE  FOR  READING  FROM  TAPE  4 

I N=4  $  CALL  REDR ( AHEAD, DI SCPT( 1 0) , IN, 2) 

READ  (IN, 26)  A1 

158  READ  (IN, 26)  I  NDC,  (AM),  1=1,6) 

IF  ( I NDC  .NE.  1 HC )  GO  TO  159 

WRITE  (6,26)  I DD, (A( I ) , I =1 , 8) , NI ND, I DD, NI N, I N 
GO  TO  158 

159  DECODE  (80, 23, A)  A1 , NTEDT, A2, NJEDI T, A3, NREZON, A4, NALPHA 
IF  (NALPHA  .EQ.  0)  NALPHA= 1 

WRITE  (6,23)  A1 , NTEDT, A2, NJEDIT, A3, NREZON, A4, NALPHA, NI ND, I DD, 

1  NIN, IN 

IF  (NTEDT  .EQ.  0)  GO  TO  170 

DO  165  NT= 1 , NTEDT, 7  $  NZ=NT-1 

READ  UN,  1020)  A ( NT ) ,  ( TED  I T ( I +NZ ) ,  1  =  1 , 7 ) 

165  WRITE  (6,20)  A ( NT ) ,  ( TED  I T ( I +NZ ) ,  I  =  1 , 7 ) , N 1 ND,  I DD, N I N,  I N , NAT 
170  IF  (NJEDIT  .EQ.  0)  GO  TO  175 
NZ=8*N JED  I T 

READ  (IN, 30)  ( A ( 4000+ I ), 1=1 ,NZ) 

WRITE  (6,30)  ( A ( 4000+ I ), 1=1, NZ) 

WRITE  (6,27)  NIND, IDD, NIN, IN 
175  IF  (NREZON)  178,180,177 
177  READ  (IN, 22)  A1 , ( NTR ( I ) , I = 1 , NREZON ) 

WRITE  (6,22)  A1 , (NTR( I ), 1=1 , 14), NIND, IDD, NIN, IN 
READ  (IN, 22)  A1 , ( JREZON ( I ) , I = 1 , NREZON ) 

WRITE  (6,22)  A1 , (JREZON(I), 1=1, 14), NIND, IDD, NIN, IN 
GO  TO  180 

1 78  READ ( IN, 1 021 )A1 , DTMAX , A2, TREZON, A3, NARZ, A4, TARZ 

WRITE (6, 21 )A1 , DTMAX, A2, TREZON, A3, NARZ, A4, TARZ, NIND, IDD, NIN, IN, NAT 
180  READ ( IN, 1 025 ) A1 , NED  IT, A2, JCYCS, A3, CKS, A4, TS 

WRITE  (6,25)  A1 , NED I T, A2, JCYCS, A3, CKS, A4, TS, NI ND, IDD, NIN, I N, NBT , 

1  NAT 
NPERN= 1 

IF  (NEDIT  .GT.  0  .OR.  JCYCS  . EQ .  0)  GO  TO  190 
NED  I T  =  MAXO ( 1 , -NEDIT) 

READ  (IN, 22)  A1 , ( MAXPR ( I ) , I = 1 , 1 4 ) 

WRITE  (6,22)  A1 , (MAXPR( I ) , I =1 , 14) ,NIND, IDD, NIN, I N 
1 90  READ ( IN,  1 073) A1 , NMTRLS, A2, MATFL, A3, UZERO, A4,  I  PLOT, NSCRB 
WRITE  (6,73)  A1 , NMTRLS, A2, MATFL, A3, UZERO, A4, IPLOT, NSCRB 
WR I TE ( 6, 27 )  NIND, IDD, NIN, I N, NCT , NDT 
I  I  PLOT  =  0 
DO  191  1=1,4 

I  I  PLOT  = I  I  PLOT  + I  PLOT ( I  ) 

IF  ( I  PLOT ( I )  .EQ.  0)  GO  TO  191 

READ ( IN, 1 020 )A1 , XMAX ( I ) , XM I N ( I ) , YMAX ( I ) , YM I N ( I ) 

WRITE  (6,20)  A1 , XMAX ( I ) , XM I N ( I ) , YMAX ( I ) , YM I N ( I ) 

191  CONTINUE 

IF  (I IPLOT  .EQ.  0)  GO  TO  192 
READ  (  IN, 22)  A1 ,  I  A 
WRITE  (6,22)  A1 , IA 

192  CONTINUE 

IF  (IND  .EQ.  1 HX )  CALL  EXTRA 

****  M-LOOP  **** 

DO  290  M=1, NMTRLS 
I  N  =  5 

WRITE  (6,69) 

CZQ ( M ) =4 .  $  CWQ ( M ) =0 . 15 

TENS ( M, 1 ) =TENS(M, 2) =-1 .Ell  $  TENS(M,3)=-1 .0 

Y  0S  =  0 . 

200  READ ( I N, 1 090) I ND, MATL(M, 1 ) , MATL (M, 2 ) , A1 , RHOS(M) , A2, NCMP(M) , NFR(M) 
1  NPOR(M) , A3, NDS(M) , NPR(M) , NY AM, A4 , NVAR ( M ) , A5, NCON(M) 

WRITE  (6,90)  IDD, MATL (M, 1 ) , MATL ( M, 2) , A1 , RHOS(M) , A2, NCMP(M) , NFR(M) 
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121 
122 
1  23 
1  24 
1  25 
126 
127 
1  28 
1  29 
1  30 
1  31 
1  32 
1  33 

134 

135 

136 
1  37 
1  38 
1  39 

140 

141 

142 

143 

144 
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148 

149 
1  50 

151 

152 

153 
1  54 
1  55 

156 

157 

158 

159 
1  60 
161 
162 
1  63 

164 

165 

166 
1  67 
168 

169 

170 

171 

172 

173 

174 

175 
1  76 
177 
1  78 
1  79 
1  80 
1  81 
182 

183 

184 
1  85 
1  86 

187 

188 

189 

190 

191 

192 

193 
1  94 
195 


245 


SUBROUTINE  GENRAT  (Continued) 


1  NPOR(M) , A3, NDS(M) , NPR(M) , NY AM, A4, NVAR(M) , A5, NCON(M) 

GENRAT 

1  96 

2  , N I ND , I ND, N I N, I N, N5T 

GENRAT 

197 

IF  (IN  .EQ.  4  .OR.  IND  . EQ .  IDD)  GO  TO  205 

GENRAT 

1  98 

I  N  =  4 

GENRAT 

199 

CALL  REDR ( MATL ( M,  1  ),MATL(M,2),  IN,  2) 

GENRAT 

200 

IF  (IND  .EQ.  1 HT )  GO  TO  200 

GENRAT 

201 

READ ( I N, 1 090) I ND, A 1 , A2, A3, A4 , A5, N1 , N2, N3 , A6 , N4 , N5 , NY AMT , A7, A8, N6 

GENRAT 

202 

WRITE  (6, 90)  I DD, A1 , A2, A3, A4, A5, N1 , N2, N3, A6, N4, N5, NYAMT, A7, A8, N6, 

GENRAT 

203 

1  NIND, IND, N I N , IN,N5T 

GENRAT 

204 

205 

RHO ( M ) =  RHOS ( M ) 

GENRAT 

205 

IF  (NCMP(M)  .NE.  0)  GO  TO  2055 

GENRAT 

206 

C 

****  READ  IN  EQST  VARIABLES  **** 

GENRAT 

207 

READ ( IN, 1 020) A1 , EQSTC(M) , EQSTD(M) , EQSTE(M) , EQSTG(M) , EQSTH(M) , 

GENRAT 

208 

1  EQSTS(M) , EQSTV(M) 

GENRAT 

209 

WRITE  (6,20)  A1 , EQSTC(M) , EQSTD(M) , EQSTE(M) , EQSTG(M) , EQSTH(M) , 

GENRAT 

210 

1  EQSTS(M) , EQSTV(M) , N I ND , I DD , N I N , I N, NFT, NGT, NHT, NIT 

GENRAT 

21  1 

IF  ( A 1  .EQ.  1  OH  EQSTX=  )  READ  (IN,  1020)  A2, EQSTA ( M) ,A3,A4,A5,A6, 

GENRAT 

212 

1  A7,A8 

GENRAT 

213 

IF  ( A1  .EQ.  1  OH  EQSTX=  )  WRITE  (6,20)  A2 , EQSTA ( M ), A3, A4 , A5, A6, 

GENRAT 

214 

1  A7, A8, N I ND, I DD, N I N, IN 

GENRAT 

215 

IF  (NPR(M)  .LE.  1  .OR.  NPR(M)  . EQ .  7)  CALL  EQST ( A 1 , A2 , A3 , M ) 

GENRAT 

216 

LS  =  -1 

GENRAT 

217 

EMELT(M) =0. 1 #EQSTE ( M ) 

GENRAT 

218 

CALL  FMELT ( LS, M , EMELT ( M ) , A 1 , A2,X,MS) 

GENRAT 

219 

IF  (NCMP(M)  .EQ.  0)  GO  TO  2059 

GENRAT 

220 

C 

GENRAT 

221 

C 

****  READ  COMPOSITE  DATA  **** 

GENRAT 

222 

2055 

CONTINUE 

GENRAT 

223 

LS=  - 1 

GENRAT 

224 

CALL  REBAR (LS, IN,J,I,M,N,H(J,3), RHOS(M) , DOLD, EXMAT ( M, 3 ) , SY , SZ, 

GENRAT 

225 

1  TXY , EH, PHL ( J ) , EX, EY , EZ, EXY , F, 0 . , 0 . , ESC,FS, COM( 1 ) , C0M(2) , COM (6) , 

GENRAT 

226 

2  COM ( 7 ) , YO ( M ) , COM ( 8 ) , IPRT) 

GENRAT 

227 

NV AR ( M) = MAXO ( NVAR ( M) , 7) 

GENRAT 

228 

RHO(M) =RHOS(M) 

GENRAT 

229 

GO  TO  245 

GENRAT 

230 

2059  CONTINUE 

GENRAT 

231 

C 

GENRAT 

232 

C 

####  READ  FRACTURE  DATA  **** 

GENRAT 

233 

NFRM=NFR ( M ) +1 

GENRAT 

234 

GO  TO  (210,206,207,208,208,207)  NFRM 

GENRAT 

235 

206 

CONTINUE 

GENRAT 

236 

207 

CONTINUE 

GENRAT 

237 

READ ( I N, 1 020 ) A1 , ( TSR ( M, I ) , I =1 , 7) 

GENRAT 

238 

WRITE  (6,20)  A1, (TSR(M, I), 1=1, 7), NIND, IDD,NIN, IN 

GENRAT 

239 

IF  (NFR(M)  .EQ.  1)  GO  TO  210 

GENRAT 

240 

IF  (NFR(M)  .EQ.  2)  NVAR ( M ) =MAXO ( NVAR ( M ) , 1 8 ) 

GENRAT 

241 

IF  (NFR(M)  .EQ.  5)  NVAR ( M ) =MAXO ( NVAR ( M ), 1 1 ) 

9/12/79 

3 

READ ( I N, 1 020) A1 , ( TSR ( M, I ) , I =8, 14) 

GENRAT 

243 

WRITE  (6,20)  A1 , (TSR(M, I ) , 1=8, 14), NIND, IDD, NIN, IN 

GENRAT 

244 

GO  TO  210 

GENRAT 

245 

C 

READ  FOR  SHEAR  BAND  MODEL. 

GENRAT 

246 

206 

CALL  SHEAR2 ( LSUB ( 1 5 ) , IN,M) 

GENRAT 

247 

NVAR ( M ) =MAXO ( NVAR (M ) , 5 ) 

GENRAT 

248 

LSUB ( 15) =1 

GENRAT 

249 

IF  (NFR(M)  .EQ.  4)  GO  TO  207 

GENRAT 

250 

C 

GENRAT 

251 

C 

####  READ  POROUS  DATA  #*** 

GENRAT 

252 

210 

IF  (NPOR(M)  .EQ.  0)  GO  TO  230 

GENRAT 

253 

NPORM  =  NPOR(M) 

GENRAT 

254 

GO  TO  (211,212,225,227)  NPORM 

GENRAT 

255 

21  1 

READ ( IN, 1 020 ) A 1 , RHO(M) 

GENRAT 

256 

WRITE  (6,20)  A1 , RHO ( M ) 

GENRAT 

257 

CALL  POREQST ( 0 , I N, M, EXMAT (M, 3) , RHO(M) , A2, A3, A4, A5, A6, CZQ(M) , CWQ(M) 

GENRAT 

258 

1  , A7, A8, EQSTC(M) , EQSTD(M) , EQSTG(M) , EQSTS(M) , A 1 1 , A 1 2 , YO ( M ) ) 

GENRAT 

259 

GO  TO  230 

GENRAT 

260 

212 

IF  (NPOR(M)  .GT.  2)  GO  TO  225 

GENRAT 

261 

CALL  PORHOLT ( 0, IN,M, EXMAT (M, 3) , RHO(M) , DOLD, A1 , A2 , A3, A4 , A5 , A6 , A7, 

GENRAT 

262 

1  EQSTC(M) , A9, YO(M) , RHOS(M) , A10) 

GENRAT 

263 

GO  TO  230 

GENRAT 

264 

225 

READ (5, 1 020 ) A 1 ,RHO(M) 

GENRAT 

265 

WR I TE ( 6, 20 ) A1  ,RHO(M) 

GENRAT 

266 

CALL  PEST ( LSUB ( 14) ,5, A1 , A2, A3, A4, A5, M, EXMAT ( M, 3 ) ,RHO(M) , A6, RHOS(M) 

GENRAT 

267 

1  , A7, A8, A9, A1 0, A1 1 , A1 2, A1 3, EQSTC(M) , EQSTD(M) , EQSTS(M) , EQSTG(M)  , 

GENRAT 

268 

2  A14,Y0(M) , A15, A16, CZQ(M) , CWQ(M) , EQSTH(M) , EQSTE(M) , EQSTN(M) , EQSTV 

GENRAT 

269 

3  (M) , EQSTA(M) ) 

GENRAT 

270 

246 


SUBROUTINE  GENRAT  (Continued) 


NVARCM) =MAX0( NVARCM)  ,  5) 

GENRAT 

271 

GO  TO  230 

GENRAT 

272 

227 

READ (5, 1021 )A1 , RHOCM ) , A2, MU  CM) 

GENRAT 

273 

WR I TE  (  6 ,  21  )  A 1  , RHOCM) ,  A2,  MU  CM) 

GENRAT 

274 

MU  C  M )  =  1  . 333*MU  C  M ) 

GENRAT 

275 

CALL  CAP1 (  - 1  , IN.MjHC 1 ) j RHOCM) , RHOCM) , EHLC 1)J0.J0.J0.J0.J1.JMUCM)J 

GENRAT 

276 

1  EQSTCCM) , EQSTGCM) , RHOSCM) ,  SHLC 1 ) ,SHL( 1 ) ,  SHLC 1 ) , SHLC 1 ) , NEMC 1 ) , 

GENRAT 

277 

2  K , J , NET  Cl)) 

GENRAT 

278 

EXMAT  C  M , 3 ) =SGRT  C C  EQSTCCM) +MUC  M ) ) /RHOCM) ) 

GENRAT 

279 

C 

****  READ  SPECIAL  PRESSURE  AND  DEVIATOR  STRESS  DATA  *#*# 

GENRAT 

280 

230 

IF  CNDSCM)  .EQ.  0)  GO  TO  235 

GENRAT 

281 

IF  CNDSCM)  .EQ.  7)  GO  TO  233 

GENRAT 

282 

READ  C I N,  1 020) A1 ,  C  TSRCM,  I  )  ,  I  =  1  5, 21  ) 

GENRAT 

283 

WRITE  C  6  , 20 )  A1 ,  C TSRCM,  I  )  ,  1=15,21  )JNINDJ  I DD, N I N ,  IN 

GENRAT 

284 

GO  TO  235 

GENRAT 

285 

233 

CALL  EP  C  0 , M ) 

GENRAT 

286 

235 

IF  CNPRCM)  .EQ.  0)  GO  TO  245 

GENRAT 

287 

NPRM  =  NPRCM) 

GENRAT 

288 

GO  TO  C  236 , 237 , 238 , 239, 240 , 24 1 , 245 )  NPRM 

GENRAT 

289 

236 

CALL  EXPLODE  Cl ,  IN,M, EXMAT  CM, 3 ) , A1 , A2, A3, A4 , A5, A6 , A7, A8, A9, A1 0 ) 

GENRAT 

290 

GO  TO  245 

GENRAT 

291 

237 

CALL  ESACO, IN,M) 

GENRAT 

292 

GO  TO  245 

GENRAT 

293 

238 

CALL  EQSTPFCO, IN,M) 

GENRAT 

294 

GO  TO  245 

GENRAT 

295 

239 

CALL  HYPO  CO,  I N, M, EXMAT  CM, 3) , RHOSCM) ) 

GENRAT 

296 

GO  TO  245 

GENRAT 

297 

240 

CALL  GRAY  C  0,  IN,M) 

GENRAT 

298 

GO  TO  245 

GENRAT 

299 

241 

CALL  EOSTABCO, IN,XN,YN,ZN) 

GENRAT 

300 

GO  TO  245 

GENRAT 

301 

C 

**##  READ  SPALL,  VISCOSITY,  YIELD  AND  MELT  VARIABLES  ***# 

GENRAT 

302 

C 

NY AM  IS  THE  NUMBER  OF  CARDS 

GENRAT 

303 

245 

IF  (NY AM  .EQ.  0)  GO  TO  280 

GENRAT 

304 

DO  275  NY =1, NY AM 

GENRAT 

305 

READ  ( IN, 30) (X( I ) , 1=1 ,8) 

GENRAT 

306 

DECODE  C 1 0, 24, X) (AC  I  ) ,  I  =  1  ,  1 0) 

GENRAT 

307 

DO  250  1=1,10 

GENRAT 

308 

IF  CAC I )  .EQ.  1H  )  GO  TO  250 

GENRAT 

309 

IF  (AC  I  )  .EQ.  1 HT  .AND.  A(I+1)  . EQ .  1  HE )  GO  TO  252 

GENRAT 

310 

IF  (A(I).EG.IHC  .OR.  A(I).EQ.IHV)  GO  TO  253 

GENRAT 

31  1 

IF  (AC  I  )  .EQ.  1 HY )  GO  TO  254 

GENRAT 

312 

IF  (AC  I)  .EQ.  1  HE  .OR.  AC  I)  . EQ .  1 HM )  GO  TO  270 

GENRAT 

313 

IF  (AC  I)  .EQ.  1 HT  .AND.  AC  1+1)  . EQ .  1HH)  GO  TO  256 

GENRAT 

314 

IF  (AC  I  )  .EQ.  1HG  .AND.  A(I+1)  . EQ .  1 HM )  GO  TO  272 

GENRAT 

315 

IF  (AC  I)  .EQ.  1 HS  .AND.  AC  1+1)  . EQ .  1  HP)  GO  TO  265 

GENRAT 

316 

250 

CONTINUE 

GENRAT 

317 

PRINT  67,  ( X ( I ) ,  1=1,8) 

GENRAT 

318 

GO  TO  398 

GENRAT 

319 

252 

DECODE (80,  1 020, X ) A1 ,  C  TENS (M,  I  ),  1=1,3) 

GENRAT 

320 

WRITE  (6, 20)  A1 ,  (TENS  CM,  I  )  ,  I  =  1 , 3 )  ,  (  T  C  I  )  ,  I  =  1 , 4  )  ,  N  I  ND,  I  DD,  NI  N,  I  N, NFT 

GENRAT 

321 

GO  TO  275 

GENRAT 

322 

253 

DECODE (80,  1 020, X ) A1 , CZQ ( M ) , CWQ  CM), C2(M) 

GENRAT 

323 

WRITE  (6, 20)  A1 , CZQCM) , CWQ CM) , C2 ( M ) , ( T C I ) , I = 1 , 4 ) , N I ND , I DD , N I N, I N 

GENRAT 

324 

GO  TO  275 

GENRAT 

325 

254 

DECODE (80, 1020,X)A1 , YOS,MU(M) , YADD(M) , EXMAT (M, 1  ) , EXMAT  CM, 4) 

GENRAT 

326 

WR I TE ( 6, 20 ) A 1 , YOS , MU ( M ) , YADD ( M ) , EXMAT  CM, 1 ) , EXMAT (M, 4) ,  (T(I),  1  =  1,2) 

GENRAT 

327 

1  , N I ND , I DD , N I N, I N, NJT, NJT, NJT 

GENRAT 

328 

IF  CNDSCM)  .NE.  5)  YADD  C  M ) = YADD ( M) / ( RHOS (  M  )  *  ( ,2-.5*Y0S/MU(M) ) ) 

GENRAT 

329 

IF  CNPORCM)  .EQ.  0)  Y0(M)=  YOS 

GENRAT 

330 

C 

TEST  FOR  COULOMB  FRICTION  MODEL 

GENRAT 

331 

IF  C  EXMAT ( M,  1 )  . EQ .  0.)  GO  TO  275 

GENRAT 

332 

C 

READ  IN  EXMAT  AS  TANCPHI),  AND  YOS  AS  2C 

GENRAT 

333 

ENPHI =SQRT( 1  . +EXMATCM,  1  ) * *2 ) +EXMAT  CM,  1  ) 

GENRAT 

334 

YO ( M ) = 1 . 5* YOS*ENPH I / ( 1 . +0 . 5*ENPH 1**2) 

GENRAT 

335 

EXMAT  CM, 1  )  =  1  . 5* (ENPHI **2-1  .  )/(1  . +0 . 5*ENPH 1**2) 

GENRAT 

336 

GO  TO  275 

GENRAT 

337 

265 

DECODE (80, 1 020 , X ) A 1 , SPH ( M ) 

GENRAT 

338 

WR I TE ( 6, 20 ) A1 ,SPH(M) 

GENRAT 

339 

GO  TO  275 

GENRAT 

340 

270 

LS  =  0 

GENRAT 

341 

GO  TO  273 

GENRAT 

342 

272 

LS=  1 

GENRAT 

343 

273 

DECODE  (80,1 020 , X ) A 1 ,  (AC  I  ) , 1=1,7) 

GENRAT 

344 

WRITE  (6,20)  A1 ,  (AC  I ) ,  I = 1 , 7 ) , N I ND ,  I DD , N I N,  I N, NKT 

GENRAT 

345 

247 


SUBROUTINE  GENRAT  (Continued) 


IF  (MS  . EQ.  M)  GO  TO  2732 

GENRAT 

346 

DO  2731  1=1,7 

GENRAT 

347 

IF  (LS  .EQ.  0)  EMELTCM, I ) =A( I ) 

GENRAT 

348 

IF  (LS  .EQ.  1)  GMELKMj  I  )  =A(  I  ) 

GENRAT 

349 

2731 

CONTINUE 

GENRAT 

350 

GO  TO  2733 

GENRAT 

351 

2732 

IF  (LS  .EQ.  0)  EMELT ( M ,  8 )  =  A  (  1 ) 

GENRAT 

352 

IF  (LS  .EQ.  1)  GMELT ( M , 8 ) =A ( 1 ) 

GENRAT 

353 

2733 

CALL  FMELT(LS, M, EMELT(M) ,A1 JA2JAJMS) 

GENRAT 

354 

GO  TO  275 

GENRAT 

355 

256 

DECODE (80,  1 020, X ) A 1 ,  ( THERM (M,  15,1=1,5) 

GENRAT 

356 

WRITE  (6,20)  A 1 , ( THERM (M, I), 1=1,7), NIND, IDD,NIN, IN, NKT 

GENRAT 

357 

275 

CONTINUE 

GENRAT 

358 

C 

****  READ  IN  EDGE  VARIABLES 

GENRAT 

359 

280 

IF  (NCON(M)  .GT.  0  .AND.  MATFL  . EQ .  0)  CALL  DEP0S(1,IN) 

GENRAT 

360 

ESC (M, 1  ) =  RHO ( M )  $  ESC ( M , 2 ) =EQSTC (M ) 

GENRAT 

361 

ESC (M, 3 ) =EQSTD (M )  $  ESC ( M, 4 ) =EQSTS ( M ) 

GENRAT 

362 

ESC (M, 5 ) =MU ( M )  $  ESC(M, 6) =YADD(M) 

GENRAT 

363 

ESC ( M, 7 ) =RHOS ( M )  $  ESC(M, 9)=EQSTG(M) 

GENRAT 

364 

ESC ( M, 1 0 ) =Y0 ( M ) 

GENRAT 

365 

THERM (M, 6 ) = EMELT (M, 1 ) 

GENRAT 

366 

THERM ( M, 8 ) =  EQSTE (M ) 

GENRAT 

367 

290 

CONTINUE 

GENRAT 

368 

C 

GENRAT 

369 

C 

####  end  of  m-loop**** 

GENRAT 

370 

WRITE  (6,69) 

GENRAT 

371 

C 

GENRAT 

372 

C 

#***  READ  IN  ZONING  VARIABLES  **** 

GENRAT 

373 

C 

GENRAT 

374 

DO  291  L=1 , 30 

GENRAT 

375 

JBND ( L ) =  0 

GENRAT 

376 

291 

THK(L) =0. 

GENRAT 

377 

IN  =  5 

GENRAT 

378 

READ  (5,66)  A1 , NLAYER, A2, ( JMAT ( L ) , L= 1 , 1 0 ) 

GENRAT 

379 

WRITE  (6,66)  A1 , NLAYER, A2, (JMAT(L) , L=1 , 10) , NIND, IDD, NI N, IN 

GENRAT 

380 

IF  (NLAYER  .LE.  1 0 )  GO  TO  292 

GENRAT 

381 

READ  (5,80)  (JMAT(L) , L=1 1 , NLAYER) 

GENRAT 

382 

WRITE  (6,80)  ( JMAT ( L ) , L= 1 1 , NLAYER ) 

GENRAT 

383 

292 

I NFF  = I NFL  =  0 

GENRAT 

384 

IF  ( JMAT ( 1  )  .LT.  0)  I NFF  = 1 

GENRAT 

385 

IF  ( JMAT ( NLAYER )  .LT.  0)  INFL=1 

GENRAT 

386 

JMAT ( 1 ) = I ABS ( JMAT ( 1 ) ) 

GENRAT 

387 

JMAT ( NLAYER ) = I ABS (JMAT ( NLAYER ) ) 

GENRAT 

388 

READ  (5, 30)  (X(I ), 1=1,8) 

GENRAT 

389 

DECODE ( 4 , 1 062,  X)A1 

GENRAT 

390 

IF  ( A 1  .NE.  4H  THK )  GO  TO  293 

GENRAT 

391 

DECODE (80, 1 01 9,X)A1 , A2, (THK(L) , L=1 , 7) 

GENRAT 

392 

WRITE  (6,19)  A 1 , A2 , ( THK ( L ) , L= 1 , 7 ) 

GENRAT 

393 

IF  (NLAYER  . LE .  7)  GO  TO  2921 

GENRAT 

394 

READ (5, 1075) (THK(L) ,L=8, NLAYER) 

GENRAT 

395 

WRITE  (6,75)  (THK(L) , L=8, NLAYER) 

GENRAT 

396 

2921 

IF  ( A2  .NE.  5H  INCH  )  GO  TO  399 

GENRAT 

397 

C 

GENRAT 

398 

C 

CONVERSION  OF  THK(L)  FROM  INCHES  TO  CM 

GENRAT 

399 

DO  2922  L=1, NLAYER 

GENRAT 

400 

2922 

THK ( L ) =2 . 54  *  THK ( L ) 

GENRAT 

401 

GO  TO  399 

GENRAT 

402 

293 

DECODE (80, 1 062, X)A1 , A2, NZONES( 1 ) , NCELLS ( 1  ,  1  ) , A3, A4 , TH ( 1 , 1  ) , A5, A6 , 

GENRAT 

403 

1  DELX ( 1 , 1 ) , A7, A8, DELF I N ( 1 , 1 ) 

GENRAT 

404 

DO  300  L=1, NLAYER 

GENRAT 

405 

IF(L. GT. 1 ) READ (5, 1 062) A1 , A2, NZONES(L) , NCELLS (L, 1 ) , A3, A4 , TH ( L , 1 

GENRAT 

406 

1 ) , A5, A6, DELX ( L , 1 ) , A7, A8, DELF I N(L, 1 ) 

GENRAT 

407 

WRITE  (6, 62)  A 1 , A2, NZONES(L) , NCELLS (L, 1 ) , A3, A4 , TH ( L, 1 ) , A5, A6 , DELX 

GENRAT 

408 

1  ( L, 1 ) , A7, A8, DELF I N ( L, 1 ) , N I ND, I DD, N I N, IN, NLT 

GENRAT 

409 

NZON=N ZONES ( L ) 

GENRAT 

410 

IF  (NZON  . EQ.  1 )  GO  TO  2951 

GENRAT 

41  1 

DO  295  N 1 =2 , NZON 

9/12/79 

4 

READ (5,  1 064 ) A 1 , A2, NCELLS (L,  NI  ) , A3, A4 , TH ( L , N 1 ) , A5 , A6 , DELX ( L ,  N 1  )  , 

9/12/79 

5 

1  A7, A8, DELF I N ( L, NI ) 

9/12/79 

6 

295 

WRITE  (6, 64)  A 1 , A2, NCELLS (L, NI ) , A3, A4, TH (L , N 1 ) , A5, A6, DELX ( L , NI ) , 

9/12/79 

7 

1  A7,A8,DELFIN(L,N1),NIND, I DD, N I N, IN, NLT 

9/12/79 

8 

2951 

IF  ( A5  .NE.  5H  INCH)  GO  TO  300 

GENRAT 

417 

C 

GENRAT 

418 

C 

CONVERSION  OF  TH ( L, N ) ,  DELX( L, N )  FROM  INCHES  TO  CM 

GENRAT 

419 

DO  2952  NI =1 , NZON 

9/12/79 

9 

SUBROUTINE  GENRAT  (Continued) 


TH ( L, N 1  )=2.54*TH(L,N1 ) 

9/12/79 

10 

2952 

DELX ( L ,  N1 )=2.54*DELX(LJN1  ) 

9/12/79 

1  1 

300 

CONTINUE 

GENRAT 

423 

C 

GENRAT 

424 

C 

****  CALCULATE  ZONING  AND  INITIALIZE 

CELL  COORDINATES  ***  GENRAT 

425 

NULL=0  $  XZER0=O .  $  J=1  $  X(1)=0. 

GENRAT 

426 

DO  390  L= 1 , NLAVER 

GENRAT 

427 

IF  (JMAT(L)  .EQ.  0)  GO  TO  385 

GENRAT 

428 

NZON=NZONES(L) 

GENRAT 

429 

DO  380  NZ= 1 . NZON 

GENRAT 

430 

FN=NCELLS(L, NZ)  $  RATI0=1.  $  FI=0.  $  DX=DELX ( L , NZ )  GENRAT 

431 

IF  ( DX*DELF I N ( L, NZ )  . EQ .  0.)  GO  TO  345 

GENRAT 

432 

C 

PREPARE  FOR  GEOMETRIC  PROGRESSION  OF  CELLS  GENRAT 

433 

RAT I 0=DELF I N ( L ,  NZ ) 

GENRAT 

4  34 

DX= ( 1 . -RAT I 0 ) / ( 1 . -RATIO**FN)*TH(L, NZ )  $ 

GO 

TO  360  GENRAT 

435 

C 

PREPARE  FOR  ARITHMETIC  PROGRESSION 

OF 

CELLS  GENRAT 

436 

345 

IF  (DX  . NE.  0, )  GO  TO  355 

GENRAT 

437 

IF  ( DELF I N ( L , NZ )  . NE .  0.)  GO  TO  350 

GENRAT 

438 

DX=TH(LJ NZ)/FN  $  GO  TO  360 

GENRAT 

439 

350 

DX=2 . *TH ( L, NZ)/FN-DELFIN(L,NZ) 

GENRAT 

440 

355 

F I =2 . * ( TH ( L j  NZ ) /FN-DX) / ( FN - 1  .  ) 

GENRAT 

441 

360 

JN= J+NCELLS ( L,  NZ)  $  J1=J+1 

GENRAT 

442 

DO  365  I = J 1 j  JN 

GENRAT 

443 

X(  I  ) =X( I  - 1  ) +DX 

GENRAT 

444 

X0( I )=X( I ) 

GENRAT 

445 

365 

DX  =  RAT  I 0*DX+F I 

GENRAT 

446 

380 

J  =  JN  S  JBND (  L )  =  J  $  J  =  J  +  1 

GENRAT 

447 

XZERO=X( J)=X( J-1 ) 

GENRAT 

448 

XO ( J ) =X ( J ) 

GENRAT 

449 

GO  TO  390 

GENRAT 

450 

385 

XZERO=X( J)=XZERO+TH(LJ  1  ) 

GENRAT 

451 

NULL=NULL+1 

GENRAT 

4  52 

390 

CONTI NUE 

GENRAT 

453 

J I N I T= 1  S  JF I N= J 

GENRAT 

454 

C 

****  RESET  JBNDS  IF  SOME  LAYERS  ARE  VACANT. 

GENRAT 

455 

NULL=0 . 

GENRAT 

456 

DO  395  L= 1 , NLAYER 

GENRAT 

457 

IF  (JMAT(L)  .EQ.  0)  GO  TO  393 

GENRAT 

458 

JBND ( L-NULL ) = JBND ( L ) 

GENRAT 

459 

JMAT ( L -NULL ) = JMAT ( L ) 

GENRAT 

460 

GO  TO  395 

GENRAT 

461 

393 

NULL=NULL+1 

GENRAT 

462 

395 

CONTINUE 

GENRAT 

463 

NLAYER= NLAYER -NULL 

GENRAT 

464 

396 

IF  (JFIN  .LE.  201)  GO  TO  399 

GENRAT 

465 

WRITE  (  6,96)  JFIN 

GENRAT 

466 

398 

READ ( 5, 30 )  ( A ( I )  ,  1=1,8) 

GENRAT 

467 

PRI NT  30,  ( AC  I ) ,  1=1,8) 

GENRAT 

468 

IF  ( EOF ( 5) )  100,398 

GENRAT 

469 

c 

GENRAT 

470 

C 

****  READ  RADIATION  SOURCE  DATA  **** 

GENRAT 

471 

399 

IF  ( MATFL  .EQ.  0)  CALL  DEP0S(2,IN) 

GENRAT 

472 

c 

GENRAT 

473 

c 

****  INITIALIZE  THE  J -ARRAY  VARIABLES 

*#*#  GENRAT 

474 

c 

GENRAT 

475 

DO  601  1=1, 2400 

GENRAT 

476 

601 

CHL ( I ) =0 . 

GENRAT 

477 

J  1  =  1 

GENRAT 

478 

LVMAX= 1 

GENRAT 

479 

DO  630  L=1, NLAYER 

GENRAT 

480 

M= JMAT(L) 

GENRAT 

481 

YOM= YO ( M ) 

GENRAT 

482 

IF  (NPOR(M)  .NE.  0)  GO  TO  602 

GENRAT 

483 

IF  (NPR(M)  .EQ.  4)  GO  TO  602 

GENRAT 

4  84 

DET= EXMAT (M. 3) 

GENRAT 

485 

CJ  =  AMAX1 ( DET . SQRTC ( EQSTC(M)  +  1 . 333*MU(M) )/RHOS(M) ) , 5 . E4 )  GENRAT 

486 

HH=SOL I D  $  GO  TO  603 

GENRAT 

487 

602 

HH  =  POROUS  $  CJ  =  EXMAT  CM, 3) 

GENRAT 

488 

IF  (RHO(M)  .EQ.  RHOS(M))  HH  =  SOLID 

GENRAT 

489 

603 

JN= JBND ( L ) 

GENRAT 

490 

DO  61 0  J=J1 , JN 

GENRAT 

491 

CHL ( J ) =CJ 

GENRAT 

492 

DHL ( J ) =RHO ( M ) 

GENRAT 

493 

H( J, 1 ) =HH 

GENRAT 

494 

IF  (NPR(M)  .EQ.  1)  CALL  EXPLODE C 2, I N , M , EHL , 

DHL 

, DOLD , PHL , SHL , NEM , X ,  GENRAT 

495 
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SUBROUTINE  GENRAT  (Continued) 


1  J,A1,A2,A3) 

GENRAT 

496 

IF  (NVAR(M)  .LE.  0)  GO  TO  604 

GENRAT 

497 

LVAR ( J ) =LVMAX 

GENRAT 

498 

LVMAX  =  LVMAX+NVAR ( M ) 

GENRAT 

499 

604 

CONTINUE 

GENRAT 

500 

IF  (NPOR(M)  .EQ.  3)  COM ( LVMAX+3 ) = 1 . -RHO ( M ) /RHOS ( M ) 

GENRAT 

501 

IF  (J  .NE.  J1)  H  ( J , 2 ) = NORMAL 

GENRAT 

502 

H ( J , 3 ) =2 

GENRAT 

503 

T  (  J  )  =  TENS ( M ,  1 ) 

GENRAT 

504 

YHLC  J ) =YOM 

GENRAT 

505 

ZHL ( J ) =DHL ( J ) * (X ( J+1 > #  *NALPHA-X ( J ) ##NALPHA ) 

GENRAT 

506 

NDSM1 =  NDS ( M )  + 1 

GENRAT 

507 

GO  TO  (610,610, 605 , 606, 610, 607,  605,  610)  NDSM1 

GENRAT 

508 

605 

NEM( J)=TSR(M, 21 )  $  GO  TO  610 

GENRAT 

509 

606 

NEM ( J ) =TSR ( M, 19)  $  GO  TO  610 

GENRAT 

510 

607 

NEM ( J ) =YHL ( J ) 

GENRAT 

51  1 

610 

CONTINUE 

GENRAT 

512 

H ( J 1 , 2 ) =R I NTER 

GENRAT 

513 

IF  ( J 1  . EQ.  1 )  GO  TO  620 

GENRAT 

514 

IF  (X(J1)  .GT.  X(JI-I))  H ( J 1 , 2 ) =SPALL 

GENRAT 

515 

620 

CONTINUE 

GENRAT 

516 

T( JN)=TENS(M, 3) 

GENRAT 

517 

H ( JN , 2 )  =  L  I NTER 

GENRAT 

518 

J1 = JN+1 

GENRAT 

51  9 

630 

CONTINUE 

GENRAT 

520 

ZHL( JFIN-1 ) =0 . 

GENRAT 

521 

H ( 1 , 2)=H( JFIN, 2)=SPALL 

GENRAT 

522 

IF  ( INFF  .EQ.  1 )  H ( 1 ,2)=INF 

GENRAT 

523 

IF  ( I  NFL  .EQ.  1)  H ( JF I N, 2 )  =  I NF 

GENRAT 

524 

IF  (INFF  .EQ.  1)  ZHL( INFF-1 )=ZHL(1 ) 

GENRAT 

525 

C 

TO  ACTIVATE  THIS  ROUTINE,  DTMAX  IS  NEGATIVE  OF  NUMBER  OF  CELLS 

GENRAT 

526 

c 

DESIRED  IN  LAYER  NUMBER ( -NREZON ) 

GENRAT 

527 

IF  (DTMAX  .GT.  0.  .OR.  NREZON  .GE.O)  GO  TO  635 

GENRAT 

528 

JB=JBND( -NREZON) 

GENRAT 

529 

XI  =0. 

GENRAT 

530 

IF  (NREZON  .EQ.  -1)  GO  TO  632 

GENRAT 

531 

JB1 = JBND ( -NREZON- 1 ) 

GENRAT 

532 

XI =X( JB1 ) 

GENRAT 

533 

632 

DTMAX= - ( X ( JB ) -XI ) / ( CHL ( JB- 1 ) * DTMAX ) 

GENRAT 

534 

NREZON= -30 

GENRAT 

535 

635 

CONTINUE 

GENRAT 

536 

DTNH= 1 . E - 1 2 

GENRAT 

537 

C 

CHECK  FOR  END  OF  DATA  DECK  AND  CALL  FOR  ADDED  READS 

GENRAT 

538 

C 

INSERT  CARD  HERE  READING  EXTRA 

GENRAT 

539 

636 

READ  30, A1 

GENRAT 

540 

IF  ( EOF ( 5 ) )  650,640 

GENRAT 

541 

640 

IF  (A1  .EQ.  1 0H  H-DATA  )  GO  TO  642 

GENRAT 

542 

IF  ( A1  .EQ.  1  OH  EXTRA  )  GO  TO  645 

GENRAT 

543 

GO  TO  398 

GENRAT 

544 

642 

CALL  HDATA(H) 

GENRAT 

545 

GO  TO  638 

GENRAT 

546 

645 

CALL  EXTRA 

GENRAT 

547 

650 

CONTINUE 

GENRAT 

548 

IF  ( MATFL )  815,700,800 

GENRAT 

549 

C*  *  *  * 

*****  DEPOSITION  EDIT 

GENRAT 

550 

700 

CALL  DEPOS ( 3, IN) 

GENRAT 

551 

GO  TO  900 

GENRAT 

552 

C 

INITIALIZE  VELOCITY 

GENRAT 

553 

800 

JFI N2= JBND ( MATFL ) 

GENRAT 

554 

I F ( UZERO . EQ . 0 . )  JFIN2=2 

GENRAT 

555 

DO  810  J=1 , JFI N2 

GENRAT 

556 

81  0 

U( J)=UZERO 

GENRAT 

557 

DTNH=0 . 02* AM I N1 ( (X( JFI N2> -X( JFI N2-1 ) ) /CHL ( JF I N2- 1 ), (X(JFIN2+2)- 

GENRAT 

558 

1  X( JFIN2+1 ) )/CHL( JFIN2+1 ) ) 

GENRAT 

559 

JSTAR= JF I N2+3  $  SDURM=1.  $  GO  TO  818 

GENRAT 

560 

815 

IF  (MATFL+2)  817,816,8151 

GENRAT 

561 

8151 

H( 1 , 2) =MI RROR  $  JSTAR=3  $  SDURM= 1 .  $  U ( 1 ) = 0 . 5*UZER0 

GENRAT 

562 

GO  TO  818 

GENRAT 

563 

816 

JSTAR=3  $  SDURMs 1 .  $  H(1,2)=PRESS 

GENRAT 

564 

GO  TO  818 

GENRAT 

565 

817 

JSTAR= JF I N  $  SDURM= 1 .  $  H ( JF I N , 2 ) =PRESS 

GENRAT 

566 

C 

GENRAT 

567 

C*********  VELOCITY  EDIT 

GENRAT 

568 

618 

IF  ( H ( 1 , 2 )  .EQ.  SPALL)  GO  TO  819 

GENRAT 

569 

A2=5HFR0NT 

GENRAT 

570 
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SUBROUTINE  GENRAT  (Concluded) 


A 1 = 1  OH  UNKNOWN 

GENRAT 

571 

IF  (H(  1  j  2)  .EG).  MIRROR)  A1=10H  MIRROR 

GENRAT 

572 

IF  ( H ( 1 j  2 )  .EQ.  INF)  A1  =  10H  INFINITE 

GENRAT 

573 

IF  ( H ( 1 , 2 )  .EQ.  PRESS)  A1=10H  PRESSURE 

GENRAT 

574 

IFCINFF  .EQ.  1)  U( JFIN+1 )=U( 1 ) 

GENRAT 

575 

PRINT  50 , A 1 , A2 

GENRAT 

576 

819 

IF  ( H ( JF I N  j  2 )  .EQ.  SPALL)  GO  TO  8195 

GENRAT 

577 

A2  =  5HREAR  $  A1=10H  UNKNOWN 

GENRAT 

578 

I F ( H ( JF I N , 2 )  .EQ.  INF)  A1=10H  INFINITE 

GENRAT 

579 

I F ( H ( JF I Nj  2 )  .EQ.  PRESS)  A1=10H  PRESSURE 

GENRAT 

580 

PRINT  50 ,  A 1 ,  A2 

GENRAT 

581 

81  95 

WRITE  ( 6  j  16)  (DISCPT( I ) , I =1 , 10) 

GENRAT 

582 

IF  (EHL(J)  .GT.  1.)  JSTAR=MAXO( JSTAR, J) 

GENRAT 

583 

DO  820  J  =  1 , JF I N 

GENRAT 

584 

820 

A ( J ) =X ( J+1 )-X(J) 

GENRAT 

585 

L=K=J1 =1 

GENRAT 

586 

825 

J2  =  M  I  NO  (  JF  I  N  -  1 , 50*K,  JBND(L)  ) 

GENRAT 

587 

M  =  JMAT ( L ) 

GENRAT 

588 

WRITE  (  6,17)  ( J,A(J) ,X(J) ,U(J) jYHL(J)jCHL(J)j 

DHL ( J ) , T ( J ) , ZHL ( J )  , 

GENRAT 

589 

1  EHL ( J ) , MATL(M, 1),(H(J,I),I=1,3),J,J=J1,J2) 

GENRAT 

590 

IF  ( J 2  .EQ.  JFIN-1)  GO  TO  900 

GENRAT 

591 

J1 =J2+1 

GENRAT 

592 

IF  ( J2  .NE.  50*K)  GO  TO  830 

GENRAT 

593 

K=K+ 1  $  WRITE  (6,16)  ( D I SCPT ( I ) , 1=1,10) 

GENRAT 

594 

830 

IF  ( J2  .NE.  JBND(L))  GO  TO  825 

GENRAT 

595 

L=L+1  $  WRITE  (6,69)  $  GO  TO  825 

GENRAT 

596 

900 

CALL  SECOND ( TW I X )  $  DUR= TW I X-F I RST 

GENRAT 

537 

WRITE  (  6, 18)  DUR 

GENRAT 

598 

WRITE  (  6,41 ) 

GENRAT 

599 

IF  ( JCYCS  .LE,  0  .OR.  LSUB(7)  . EQ .  1  )  GO  TO 

1  00 

GENRAT 

600 

C 

****  PREPARE  FOR  STORAGE  OF  HISTORIES 

*  *  ** 

GENRAT 

601 

IF  (NJEDIT  .GE.  1)  CALL  PRESCR 

GENRAT 

602 

C 

GENRAT 

603 

RETURN 

GENRAT 

604 

END 

GENRAT 

605 
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SUBROUTINE  GRAY 


SUBROUTINE.  GRAY  ( NPART . IN . M . AMU . EMELT . D , E . CH . P . DPDD . DPDE . I H ) 

GRAY 

2 

c 

GRAY 

3 

c 

GRAY  3-PHASE  EOS  OF  ROYCE  AT  LLL.  REF  UCRL-51121 

GRAY 

4 

c 

MODIFIED  IN  THE  LIQUID-VAPOR  REGION  BY  YOUNG  AT  LLL. 

GRAY 

5 

c 

REF.  UCRL-51575 

GRAY 

6 

c 

GRAY 

7 

DIMENSION  A (10) .ALFLS(IO) .AYBLS(lO) *  C ( 1 0  > *  CE2 ( 1 0 ) .CTA2I10)  » 

GRAY 

8 

1  CTB1 (10) * CTB2 (10) * C 1 LS ( 1 0 ) .C2LSI10) * C3LS  < 10) .DSLS (10) * D 1 LS  < 1 o ) * 

GRAY 

9 

2  D2LS  (10)  *  D3LS  ( 1  0  >  *  EOO  ( 1  0  )  *  GO  (10)  tGPLSUO)  »PCCLS<10)  .RPLS(IO)  * 

GRAY 

10 

3  S ( 1 0  > »  TH ( 1 0  > *  TMO ( 1 0 ) *VB(10) »VO(lO) tXJ(10) «ZJ(10) 

GRAY 

11 

DIMENSION  TEMP (50* 10) *  PRES (50*10) *VMN(50*10) *VMX (50*10) * EMN ( 50  *  1 0 > GRAY 

12 

1  »EMX(50*10) *JMX(10) 

GRAY 

13 

IF  (NPART  .GT.  o)  GO  TO  40 

GRAY 

14 

c 

GRAY 

15 

c 

«***  READ  DATA  AND  PRINT  ****GRAY 

16 

READ  1000*A1*A(M) »ALFLS(M) ,AYBLS(M) *  C ( M ) *CE2(M) *CTA2(M) *CTB1 ( M ) * 

GRAY 

17 

1  A2*CTB2 (M) .ClLS(M) ,C2LS(M) ,C3LS(M) ,DSLS(M) ,D1LS(M) ,D2LS(M) , 

GRAY 

18 

2  A3*D3LS (M) *  EOO ( M ) ,  GO (M) ,GPLS (M) .POOLS (M) ,RPLS (M) ,S (M) . 

GRAY 

19 

3  ' A4 . TH ( M ) . TMO ( M ) .VB(M),VO(M),XJ(M),ZJ(M) 

GRAY 

20 

PRINT  1000. Al. A(M)  .ALFLS ( M > . AyBlS (M).C(M).CE2(M).CtA2(M).CtB1(m). 

GRAY 

21 

1  A2.CTB2 (M) ,C1LS(M) ,C2LS(M) ,C3LS(M) ,DSLS(M) ,D1LS(M) ,02LS(M) , 

gray 

22 

2  A3.D3LS (M) ,EOO (M) ,GO (M) ,GPLS (M) .POOLS (M) ,RPLS (M) ,S (M) , 

GRAY 

23 

3  A4.TH1M) . TMO ( M ) .VB(M).VO(M),XJ(M),ZJ(M) 

GRAY 

24 

1000 

FORMAT (A10*lP7El0»3) 

GRAY 

25 

read  1001 *A1 . JMX (M) 

GRAY 

26 

PRINT  1001 .Al .JMX (M) 

GRAY 

27 

1001 

FORMAT (A10* 110) 

GRAY 

28 

I  MAX* JMX ( M ) 

GRAY 

29 

DO  30  1=1 . IMAX 

GRAY 

30 

READ  1000.A1 .TEMPI  I .M) ,VMX ( I ,M) . VMN ( I , M ) ,EMX ( I . M ) ,EMN ( I ,M ) .PRES ( I 

.GRAY 

31 

1  M) 

GRAY 

32 

PRINT  1000. Al .TEMP (I .M) . VMX ( I ,M ) . VMN ( I . M ) ,EMX ( I ,M) .EMN (I .M> .PRES ( IGRAY 

33 

1  .M) 

GRAY 

34 

30 

CONTINUE 

GRAY 

35 

RETURN 

GRAY 

36 

c 

GRAY 

37 

c 

*****  COMPUTE  PRESSURE.  SOUND  SPEED.  (DP/DDIE.  AND  <DP/DE)V 

GRAY 

38 

40 

D 1  =D 

GRAY 

39 

El=E 

GRAY 

40 

NLOOP=>0 

GRAY 

41 

50 

NLOOP=NLOOP*l 

GRAY 

42 

IF  (NLOOP-2)  100*55.60 

GRAY 

43 

55 

PR  1  =P 

GRAY 

44 

D2=D=D1+.001*D1 

GRAY 

45 

GO  TO  100 

GRAY 

46 

60 

PR2=P 

gray 

47 

D=D1 

GRAY 

48 

E*E3=E*.001*E+1.E5 

GRAY 

49 

100 

X=(VO(M)-i./D)/VO(M) 

GRAY 

50 

V=i./D 

GRAY 

51 

IF  (V  .LE.  1 . 04*VO ( M) )  GO  TO  145 

GRAY 

52 

EN=EMX ( 2  *  M ) 

GRAY 

53 

IF  (E  .GE.  1.2*EN)  GO  TO  140 

gray 

54 

c 

GRAY 

55 

c 

USE  CRITICAL  POINT  AND  TIE  LINES  TO  REPLACE  VAN  DER  WAALS  LOOPS  INGRAY 

56 

c 

LIQUID-VAPOR  PHASE. 

GRAY 

57 

c 

GRAY 

58 

VXM1=VMM1=VMN ( 1 ,M) 

gray 

59 

EXM1=EMM1=EMN(1,M) 

GRAY 

60 

E0M=EMM1+ ( EN-EMN (2  *  M  > ) * ( V-VMM1 ) / (VMX ( 2  * M ) -VMN (2 , M ) ) 

GRAY 

61 

JMAXsJMX (M) 

GRAY 

62 

DO  110  J  =  2  *  JMaX 

GRAY 

63 

VX»VMX(J.M) 

GRAY 

64 

EX*EMX ( J.M) 

GRAY 

65 

VN* VMN ( J . M ) 

GRAY 

66 

EN=EMN( J.M) 

GRAY 

b  7 

EQ=EN+ (EX-EN)*(V-VN)/(VX-VN) 

GRAY 

68 
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SUBROUTINE  GRAY  (Continued) 


IF  (E  .IT.  EQ )  GO  TO  105 

GRAY 

69 

EH=EN* (EMMl-EN) * ( V- VN ) / ( VMM  1 -VN ) 

GRAY 

70 

IF  (E  .GE.  EH)  GO  TO  140 

GRAY 

71 

El*EX* (EX-EXMl ) * (V-VX) /(VX-VXM1) 

GRAY 

72 

IF  (E-EL)  115.140.140 

GRAY 

73 

10b 

EQM=EQ 

GRAY 

74 

Vxmi=vX 

GRAY 

75 

VMM  1 »VN 

GRAY 

76 

EXM1*EX 

GRAY 

77 

EMM1=EN 

GRAY 

78 

110 

CONTINUE 

GRAY 

79 

J= JM AX 

GRAY 

b0 

EL=EX*VX/V 

GRAY 

HI 

IF  (E  .GE.  EL)  GO  TO  140 

GRAY 

82 

SL=-EN/ ( .96/ VO (M) -1 .0/VN) 

GRAY 

83 

EH=EN+SL* ( 1 .0/V-1. 0/VN) 

GRAY 

84 

IF  (E  .GE.  EH)  GO  TO  145 

GRAY 

85 

TM1=TEMP(J-1.M) 

GRAY 

86 

TM=TEMP ( J.M) 

GRAY 

87 

T= (E/EQM) * (TM-300. ) *300. 

GRAY 

88 

name*ioh  liq-vapor 

GRAY 

89 

GO  TO  120 

gray 

90 

115 

NAME=10H  liq-vapor 

GRAY 

91 

ER= (EQM-E ) / (E-EQ) 

GRAY 

92 

TM=TEMP ( J.M) 

gray 

93 

TM1=TEMP ( J-l .M) 

GRAY 

94 

T=(TM*ER*TM1)/(1.*ER) 

GRAY 

95 

120 

PQ=PRES ( J) 

gray 

96 

SLP=ALOG (PRES (J-l .M) /PQ) / ( 1 . /TM 1 - 1 . /TM ) 

GRAY 

97 

P=PQ*EXP(SLP*(1.0/T-1.0/TM) ) 

GRAY 

98 

IH=5R  D 

GRAY 

99 

GO  TO  700 

GRAY 

100 

C 

BRANCH  TO  VAPOR  LIQUID  STATE  (6) 

GRAY 

101 

140 

IF  (X  ,LT.  X J ( M ) )  GO  TO  600 

GRAY 

102 

C 

START  COMPUTATIONS  FOR  SOLID-LIQUID  STATES  (5) 

gray 

i  03 

145 

E0=(C(M)*X)**2/2./(l.-S(M)*X)Ml.*S(M)*X/3.*CE2(M)*X*X) 

GRAY 

104 

1  ♦EOO(M) *( i*GO(M) *X) 

GRAY 

105 

G=GO (M) -A (M) *X 

GRAY 

106 

Pl= (C (M) / ( i.-S (M) *X) ) **2*X*D*( l.-X-0.S*G*X)  *G*E*D 

GRAY 

107 

IF  (X  .GE.  0.)  GO  TO  150 

GRAY 

108 

TM=TMO (M) / ( 1 ,-X) **2* ( 1 .♦ (CTB1 (M) -2. ) *X*CT A2 ( M ) *X*X ) 

GRAY 

109 

GO  TO  155 

GRAY 

110 

150 

TM=TMO (M) * ( 1 .*CTB1 (M) *X*CTB2 (M) *X*X) 

gray 

111 

155 

CONTINUE 

gray 

112 

DT=DSLS(M)*( (CTB1 (M) -A (M)*X)*TM/C (M) ) **2/ ( 2 . 4* ( 1 . -X ) * ( 1 . ♦ 

gray 

113 

1  AMAX1 (0.. (4*S(M)-l,)*X) ) ) 

GRAY 

114 

TMDT=TM-DT 

GRAY 

1  15 

EM1=E0*TMDT*(3.*RPLS (M) ♦ 0 . 5*GPLS <M) *TMDT) 

GRAY 

116 

C 

BRANCH  POINT 

GRAY 

117 

IF  (E  .GT.  EMD  GO  TO  300 

GRAY 

118 

C 

GRAY 

119 

c 

****  SOLID  EQUATION  OF  STATE 

GRAY 

180 

200 

QUAD=9.*RPLS (M) **2*2.*GPLS ( M ) * (E-EO) 

GRAY 

l  2  1 

IF  (QUAD  .IT.  0.)  GO  TO  800 

GRAY 

122 

T=  (-3,*RPLS (M) *SQRT (QUAD) ) /GPLS ( M ) 

GRAY 

123 

PC= (0.666667-G) *GPLS (M) *T**2*D/2. 

GRAY 

124 

'  P=Pi*PC*PCCLS(M) 

GRAY 

125 

IH=5R  S 

GRAY 

126 

GO  TO  700 

GRAY 

127 

300 

TMDT  =  TM*DT 

GRAY 

128 

EM2=E0*TM* (DSLS (M) -o .5*ALFLS (M) )  ♦  TMDT* ( 3 . *RPLS ( M ) *0 . 5*TMDT* 

gray 

129 

1  (GPLS(M)-ALFLS(M)/TM)  ) 

GRAY 

130 

ALAMB  =-CTBl (M) ♦2**A(M)^X 

GRAY 

131 

C 

BRANCH  POINT 

GRAY 

132 

IF  (E  .GT.  EM2)  GO  TO  400 

GRAY 

133 

C 

GRAY 

134 

253 


SUBROUTINE  GRAY  (Concluded) 


C 


400 

c 

c 

c 


c 

c 

500 


c 

c 

600 


700 


600 


*»»«  MELT  EQUATION  OF  STATE  ****  GRAY 

ENU* (E-EMi )/ (EM2-EM1 )  GRAY 

ENUSA=ENU*(DSLS(M)-ALFLS(M) )  GRAY 

RNU  =  3.*RPLS  (M)  ^NUSA  GRAY 

QUAD=RNU**2*2.*GPLS  (M)  *  (  E-EO+ENU*DT*ENUSA  )  GRAY 

IF  (QUAD  .LT.  0.)  GO  TO  800  GRAY 

T= (-RNU+SQRT (QUAD) )/GPLS(M)  GRAY 

PC  =  D*  (  0  •  5*  (  0  •  666667-G )  *GPLS  (  M )  *T*T-ENUSA*  <  ALAMB*TM*G*  (  T-ENU*DT )  )  )  GRAY 
P=Pl+PC*PCCLS(M)  GRAY 

IH=6R  M  GRAY 

GO  TO  700  GRAY 

EGG=EO+TM* (28.78*RPLS(M) *DSLS (M) +46 . 0 1 7*GPLS ( M ) *TM-46 . 5 1 7 * ALFLS ( M ) GR A Y 
1  )  GRAY 

BRANCH  POINT  GRAY 

IF  (E  .GT.  EGG)  GO  TO  500  GRAY 

GRAY 

****  LIQUID  EQUATION  OF  STATE  ****  GRAY 

GAT=GPLS(M)-ALFLS(M)/TM  GRAY 

QUA0=9.*RPLS(M)**2*2.*GAT*(E-E0-TM* (DSLS <M) -0.5* ALFLS (M) ) )  GRAY 

IF  (QUAD  .LT.  0.)  GO  TO  600  GRAY 

T= (-3,*RPLS(M) ♦ SORT (QUAD) ) /GAT  GRAY 

PC  =  D* (0.5* (0.666667-G)*GPLS(M)*T**2-TM* ( DSLS ( M) -0 . 5* ALFLS ( M ) *  GRAY 

1  (l.*(T/TM)**2> >*(ALAMB+G) )  gray 

P  =  Pl ♦PC*PCCLS  (M)  GRAY 

I h=6R  L  GRAY 

GO  TO  700  GRAY 

GRAY 

*****  HOT  LIQUID  EQUATION  OF  STATE  ****GHAY 

QUAD=(3.*RPLS(M)-9.5934*ALFLS(M) ) **2*2 . *GPLS ( M ) * ( E-EO-TM* ( DSLS ( M )  GRAY 
1  *45.517**ALFLS(M)  )  )  GRAY 

IF  (QUAD  .LT.  0.)  GO  TO  600  GRAY 

T=(-(3.*RPLS(M)-9.5934*ALFLS(M) )♦ SORT (QUAD) )/GPLS(M)  GRAY 

PC  =  D* ( 0.5* (0. 66666  7-G) *GPLS ( M ) *T*T-TM* (DSLS ( M ) ♦ ALFL S ( M ) * ( 45 . 5 1 7  GRAY 
1  -9.5934*T/TM) ) ) * ( ALAMB*G)  GRAY 

P=Pl ♦PC+PCCLS (M)  GRAY 

IH=6R  H  GRAY 

GO  TO  700  GRAY 

gray 

****  LIQUID-VAPOR  equation  OF  STATE  <mm**GRAY 

Z=D*VB(M)  GRAY 

FE=0.5*VB (M) * ( ( (TH(M)-ZJ(M) )/(TH(M)-Z) ) **2* (2»*Z-2»*TH(M) )  GRAY 

1  -(2.*ZJ(M)-2.*TH(M) ) ) * ( TH(M) -ZJ (M) >/ZJ(M)**3  GRAY 

QUAD=(3.*RPLS(M)*2.*D2LS(M) ) **2- 1 6 . * ( E ♦ A Y8LS ( M ) *Z-C 1 LS ( M ) *FE  GRAY 

1  -DlLS(M) )*(C3LS(M)*FE-D3LS(M) )  GRAY 

IF  (QUAD  .LT.  0.)  GO  TO  800  GRAY 

T  = ( 3 , *RPLS ( M ) ♦2,*D2LS(M) -SORT (QUAD) ) /4 . / ( C3LS ( M ) *FE-D3LS ( M ) )  GRAY 

FP=(Z*(TH(M)-ZJ(M) )/ZJ(M)/(TH(M)-Z> )**J  GRAY 

P=RPLS (M) *T/VB (M) *Z* (1 . *Z* ( 1 .*Z* ( I .-Z) ) ) / ( 1 . -Z ) **3- A YBLS ( M ) /VB ( M )  GRAY 
1  *Z*Z  *FP*(C1LS(M) *T*(C2LS(M)+C3LS(M)*T) )  GRAY 

I  H  =  t>R  V  GRAY 

IF  ( NLOOP  .LT.  3  .AND.  CH  ,NE.  1.)  GO  TO  50  GRAY 

PR3=P  GRAY 

DPDD= (PR2-PR1 ) / (D2-D1 )  GRAY 

DPDE= (PR3-PR1 ) / (E3-E1 )  GRAY 

CH2=DPDD*Pl*DPDE/Dl**2+l . 333s AMU/D  1  GRAY 

IF  (CH2  .GT.  0»)  CH=SGRT(CH2)  GRAY 

t=E 1  gray 

D=D I  GRAY 

IF  (E  .GT.  EMELT)  P=AMAX 1 ( P , 0 . )  GRAY 

RETURN  GRAY 

continue  gray 

IH=fcR  z  gray 

p=0.  gray 

RETURN  GRAY 

END  GRAY 


135 

136 

137 

138 

139 

140 
HI 

142 

143 
1  44 
145 
1  4fe 

147 

148 
]  49 

150 

151 

152 

153 

154 

155 

156 

157 
156 

159 

160 
161 
162 
163 
1  64 
165 
1  66 

167 

168 
1  69 

170 

171 

172 
1  73 
174 
1  75 

176 

177 
176 

179 

180 
181 
162 

183 

184 
165 
1  66 
167 
188 

189 

190 

191 
1  92 
193 
1  94 

195 

196 

197 
1  98 
J  99 
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c 

c 

c 

c 

c 

c 


c 


c 


c 

c 


c 

c 


c 


c 

c 


20 

25 


1030 


50 


C 

60 


C 

65 


SUBROUTINE  HAFSTEP 


SUBROUTINE  HAFSTEP 

*  CALLED  BY  HYDRO  TO  COMPUTE  X,  U,  D,  E  FOR  THE 

*  HALFSTEP  POINT  BETWEEN  J  AND  J+1 
INPUT  -  J  ,  M. 

OUTPUT  -  UHL j  DHL,  EHL . 

I NTEGER  H, POROUS, PRESS, RI NTER, SOLI D, SPALL 
REAL  MATL, NEM, NET, NEMH, NETH 
MISCELLANEOUS 

COMMON  AZEROC 1  )  ,  CEF,  CKS,  DAVG , DELT I M, D I SCPT  ( 10), DOLD, DRHO, DTMAX, 

1  DTM I N, DTN, DTNH, DU, DX, EOLD, F, FAC, F I RST , J , JCYCS , J I NI T, 

2  JFIN, JREZON ( 15), JSMAX, JSTAR, JTS, LSUB ( 30 ) , M, MAXPRC 30 ) , N, NCYCS, 

3  NEDIT,  NPERN,  NR, NREZON, NSCRB ( 6 ) , NSEPRAT, NSPALL, NTEDT, 

4  NTEX, NTR( 15), POLD, P6 ( 20 ) , R ( 30 ) , RLAST, SLAST, SMAX, TED I T ( 50 )  , 

5  TF,  TIME, TJ, TREZON, TS, T6 ( 20 ) , ULAST, UOLD, UZERO, XLAST, XNOW, XOLD 

1  , XJD I T ( 20 ) , MS 

HALFSTEP  VALUES 

COMMON  DH, DHLAST, DUH, EH, PH, RH, RHLAST, SH , SHLAST, UH, UHLAST, XH , XHLAST 
1  , NEMH, NETH 

CONDITION  INDICATORS 

COMMON  I NF, L I NTER, MI RROR, NORMAL, POROUS, PRESS, R I NTER, SOL  ID,  SPALL 
CELL  LAYOUT 

COMMON  DXXC30) , JBNDC30) , JMATC30) , NAUTO, MATL ( 6 , 2 ) , NLAYER,  NMTRLS , 

1  THK ( 30 ) 


COORDINATE  ARRAYS 

COMMON/ COORD/ X ( 200 ) , XO ( 200 ) , CHLC200) , DHL ( 200 ) , DPDDC 200 ) , DPDE ( 200 ) , 

1  EHL (200) , H(200, 3) , NEM ( 200 ) , NET (200) , PHL(200) , RHL ( 200 ) , SDT ( 200 ) , 

2  SHL(200),T( 200 ) , U ( 200 ) , YHL ( 200 ) , ZHL ( 200 ) 

NAMED  COMMON 
REAL  MU, MUM 

COMMON  /EQS/  EQSTA ( 6 ) , EQSTC ( 6 ) , EQSTD ( 6 ) , EQSTE ( 6 ) , EQSTG ( 6 ) , 

1  EQSTH ( 6 ) , EQSTN ( 6 ) , EQSTS ( 6 ) , EQSTV ( 6 ) , CZQ ( 6 )  ,  CWQ ( 6 )  ,  C2 ( 6 ) 

COMMON  /MELT/  EMELT ( 6, 8) , GMELT( 6, 8 ) , SPH ( 6) , THERM( 6, 6 ) 

COMMON  /RHO/  RHO ( 6 ) , RHOS ( 6 ) 

COMMON  /TSR/  TSR( 6, 30 ) , EXMAT ( 6, 20 ) , TENS( 6, 3 ) 

COMMON  /Y/  Y0(6) , YADDC6) , MU( 6) , MUM, YADDM 

COMMON  /IND/  I  EOS ( 6) ,  I NDK( 20) , N ALPHA, NCMP( 6)  ,  NFR( 6)  ,  NPOR( 6)  , 

1  NDS ( 6 ) , NPR (6) , NCON ( 6 ) , NVAR(6) 

COMMON  /RAD/  SST0P(9) , START ( 9) , SDURM, SSTOPM, NSPEC, SSJ, JSS, I PL0T(4) 
1  , XMAX ( 4 ) , XM I N ( 4 ) , YMAX ( 4 ) , YM I N ( 4 ) ,  I A ( 7 ) ,  I T I TLE ( 24 ) , NARZ , TARZ 


DX=X ( J+1 ) -X ( J )  $  EOLD=EHL ( J ) 

DOLD=DHL( J) 

IF  (NALPHA  .GT.  1 )  GO  TO  20 

DHL ( J )  =  DH  =  DHEND  =  ZHL ( J ) / ( DX+O . 5*DTNH* ( U ( J+1 ) -U ( J ) ) ) 

GO  TO  25 

DHL ( J ) = DH= DHEND = ZHL ( J ) / ( (X( J  +  1 ) +0 . 5*DTNH*U ( J  +  1 ) ) *  * NALPHA- ( X ( J )  + 

1  0. 5#DTNH*U( J) )**NALPHA) 

IF  (NPR(M)  .EQ.  7)  GO  TO  200 

NSC=MAX1 ( 1 . , 100. * ABS ( (DHEND -DOLD) ) / ( DHEND+DOLD ) ) 

NSC  =  M I  NO ( NSC, 10) 

DDH  =  ( DHEND-DOLD) /NSC 

SSC=0.  $  IF  (NSPEC  .NE.  0  .AND.  SDURM  . LT .  1.)  SSC=SSCALH ( J ) /NSC 

IF  (NSC  .EQ.  1 )  GO  TO  50 
PRINT  1 030, NSC, J , N 

FORMAT  (*  SUBCYCLING  IN  HAFSTEP,  NSC=*I3,*  FOR  J=*I3,#,  N=*I5) 

DTNS  =  DTN 

DTNHS  =  DTNH 

DTNH  =  DTNH/NSC 

DO  1 20  NS  =  1 , NSC 

DHL ( J )  s  DH  =  DOLD+DDH 

HDV=0.5*(1 . /DOLD- 1 ./DH) 

RHOLD=SHL ( J ) +FAC* (RHL(J)-SHL(J)) 

EH=EOLD+HDV#FAC# ( 2 . *RHOLD+DPDD( J ) * ( DH-DOLD ) +DPDE ( J ) *SSC ) +SSC 
IF  (NALPHA-2)  70,60,65 
CYLINDRICAL  CASE 

EZ=(SHL(J)-PHL(J) -SDT ( J ) )* ( -2. *HDV-(U( J+1 ) -U ( J ) ) * ( DTNH+DTN) / 

1  (X( J+1 ) -X  ( J ) )/( DH+DOLD ) ) 

EH=EH+EZ  $  GO  TO  70 
SPHERICAL  CASE 

EZ= 1  . 5#(SHL(J)-PHL(J) )  #  (  2 . *HDV-(U( J  +  1 ) -U ( J ) )#( DTNH+DTN) /( X ( J  +  1  ) - 
1  X( J) ) / ( DH+DOLD ) ) 
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PUFCOM 

12 

PUFCOM 

13 

PUFCOM 

14 

PUFCOM 
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PUFCOM 
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PUFCOM 
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PUFCOM 
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PUFCOM 
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2 
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3 
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4 
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2 
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3 
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4 
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5 
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6 
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7 
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8 

EQSTCOM 

9 
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2 
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3 
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2 
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14 
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16 
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17 
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18 
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19 

HAFSTEP 

20 
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21 

HAFSTEP 

22 

HAFSTEP 

23 

HAFSTEP 

24 

HAFSTEP 

25 

HAFSTEP 

26 

HAFSTEP 

27 

HAFSTEP 

28 

HAFSTEP 

29 

HAFSTEP 

30 

HAFSTEP 

31 

HAFSTEP 

32 

HAFSTEP 

33 

HAFSTEP 

34 

HAFSTEP 

35 

HAFSTEP 

36 

HAFSTEP 

37 

HAFSTEP 

38 

HAFSTEP 

39 

HAFSTEP 

40 

HAFSTEP 

41 

HAFSTEP 

42 

HAFSTEP 

43 

HAFSTEP 

44 
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45 
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46 
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SUBROUTINE  HAFSTEP  (Concluded) 


EH=EH+EZ 

HAFSTEP 

47 

70 

CONTINUE 

HAFSTEP 

48 

C 

CALL  HSTRESS  TO  COMPUTE  STRESS  VARIABLES 

HAFSTEP 

49 

CALL  HSTRESS 

HAFSTEP 

50 

RHL ( J ) =RH 

HAFSTEP 

51 

EHL(J)  =  EH 

HAFSTEP 

52 

IF  (NPR(M)  .EQ.  1  .OR.  NPR(M)  . EQ .  4)  GO  TO  90 

HAFSTEP 

53 

RHL ( J ) =RH= ( RH+DPDEC  J ) * ( EOLD+SSC-EH+FAC*HDV*RHOLD ) ) / ( 1  . -HDV*DPDE( J ) 

HAFSTEP 

54 

1  #FAC ) 

HAFSTEP 

55 

EHL ( J ) *EH= ( RHOLD+SHL ( J ) +FAC* ( RH -SHL ( J ) ) ) *HDV+EOLD+SSC 

HAFSTEP 

56 

IF  (NALPHA  .GT.  1)  EHL ( J ) =EHaEH+EZ 

HAFSTEP 

57 

IF  (NPR(M)  .NE.  3)  GO  TO  90 

HAFSTEP 

58 

DPDDA  =  EQSTG (M ) * EH+EQSTC ( M ) / RHO ( M ) 

HAFSTEP 

59 

IF  (DH  .EQ.  DOLD)  GO  TO  80 

HAFSTEP 

60 

DPDD(J)=(RH-RHOLD-DPDE(J) *SSC) / ( DH-DOLD ) 

HAFSTEP 

61 

80 

IF  (DPDD(J)  .LE.  0.  .OR.  DPDD(J)  . GT .  1,5*DPDDA)  DPDD ( J ) =  DPDDA 

HAFSTEP 

62 

90 

IF  (NSC  .EQ.  1 )  GO  TO  140 

HAFSTEP 

63 

DOLD  =  DH  $  EOLD  =  EH 

HAFSTEP 

64 

DTN  =  DTNH 

HAFSTEP 

65 

1  20 

CONTINUE 

HAFSTEP 

66 

DTN  =  DTNS 

HAFSTEP 

67 

DTNH  =  DTNHS 

HAFSTEP 

68 

140 

CONTINUE 

HAFSTEP 

69 

RETURN 

HAFSTEP 

70 

200 

IF  ( NSPEC  .NE.  0  .AND.  SDURM  . LT.  1.)  EHL ( J ) =SSCALH ( J ) +EHL ( J ) 

HAFSTEP 

71 

DEPS= ( DHL ( J ) -RHO ( M) ) /DHL ( J ) 

HAFSTEP 

72 

SDH=MU ( M ) *DEPS 

HAFSTEP 

73 

QH  =  0 .  $  DUH=U( J  +  1  ) -U( J )  $  CEF=CHL( J) -DUH/2 

HAFSTEP 

74 

IF  (DUH  .GT.  0. )  GO  TO  220 

HAFSTEP 

75 

CS=CHL( J) -DUH/2.  $  CF=CWQ(M) -CZQ ( M ) *DUH/CS 

HAFSTEP 

76 

QH= -0 . 5* ( CWQ ( M ) *CS-CZQ ( M ) *DUH ) *DUH* ( DH+DOLD) 

HAFSTEP 

77 

CEF=CS# ( 1 . +CF# ( 1 . +0. 5#CF) ) 

HAFSTEP 

78 

GO  TO  230 

HAFSTEP 

79 

220 

QH= -0 . 5*C2 ( M ) #CHL ( J ) *DUH* ( DH+DOLD ) 

HAFSTEP 

80 

230 

PHL ( J ) aDEPS# ( EQSTCC  M) +DEPS* ( EQSTD (M ) +DEPS#EQSTS ( M) ) ) * ( 1  . -0. 5* 

HAFSTEP 

81 

1  EQSTG ( M ) * ( DHL ( J ) /RHO ( M ) - 1 . ) ) +RHOS( M) *EQSTG(M ) *EHL ( J ) 

HAFSTEP 

82 

SHL  (  J  )  =  PHL  (  J )  +SDH  $  RH«*RHL (  J )  =SHL  (  J ) +QH 

HAFSTEP 

83 

RETURN 

HAFSTEP 

84 

END 

HAFSTEP 

85 
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SUBROUTINE  HDATA 


SUBROUTINE  HDATA ( H )  HDATA 

INTEGER  H  HUATA 

DIMENSION  H(200,3)  HDATA 

READ  lOOOfAl * J1 , II *KI t A2* J2»l2tK2  HUATA 

PRINT  1000* A1 * Jl *  II  »K1  « A2« J2* 12*  K2  HDATA 

H ( J 1  *  1 1 ) =K 1  HUATA 

IE  ( J2  • EO«  0)  RETURN  HDATA 

H(J2*I2)-K2  HDATA 

RETURN  HUAtA 

1000  FORMAT(2(A10,2I5,5X,R5) )  huATA 

END  HUATA 


2 

3 

4 

5 

e> 

/ 

8 
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SUBROUTINE  HSTRESS 


c 

c 

c 

c 

c 

c 


c 

c 


SUBROUTINE  HSTRESS 

THIS  ROUTINE  CONTROLS  SWITCHING  BETWEEN  EQUATIONS  OF  STATE 
COMPUTES  RjSj  P  FOR  THE  HALFSTEP  POINT  BETWEEN  J  AND  J  +  1 
INPUT  -  J ,  Mj  DOLD ,  EOLD,  UH,  DH,  EH. 

OUTPUT  -  RH ,  SHL ,  PHL,  YHL,  H,  C. 

I NTEGER  H, POROUS, PRESS, R I NTER, SOL  I D, SPALL 
REAL  MATL, NEM, NET,NEMH,  NETH 
MISCELLANEOUS 

COMMON  AZEROC 1  ) , CEF, CKS, DAVG, DELT I M , D I SCPT ( 1 0 )  ,  DOLD,  DRHO,  DTMAX, 

1  DTMI N, DTN, DTNH, DU, DX, EOLD, F, FAC, FI RST, J,  JCYCS,  J I N I T, 

2  JFI N, JREZON( 15) , JSMAX, JSTAR , JTS , LSUB ( 30 ) , M, MAXPR ( 30 ) , N, NCYCS, 

3  NED  IT, NPERN, NR , NREZON , NSCRB ( 6 ) , NSEPRAT,  NSPALL,  NTEDT , 

4  NTEX , NTRC 15), POLD, P6 ( 20 ) , R ( 30 ) , RLAST, SLAST,SMAX, TED I T ( 50 ) , 

5  TF, TIME, TJ, TREZON, TS, T6C20) , ULAST, UOLD, UZERO, XLAST, XNOW, XOLD 
1  , X JD I T ( 20 ) , MS 

HALFSTEP  VALUES 

COMMON  DH, DHLAST , DUH, EH, PH , RH , RHLAST, SH, SHLAST, UH, UHLAST, XH, XHLAST 
1  , NEMH, NETH 

CONDITION  INDICATORS 

COMMON  I NF, L I NTER, M I RROR, NORMAL, POROUS, PRESS, R I NTER, SOL  I D, SPALL 
CELL  LAYOUT 

COMMON  DXX ( 30 ) , JBND ( 30 ) , JMATC30) , NAUTO, MATL ( 6 , 2 ) , NLAYER, NMTRLS, 

1  THK ( 30 ) 

COORDINATE  ARRAYS 

COMMON/COORD/X ( 200 ) , X0( 200) , CHLC200) , DHL ( 200)  ,  DPDDC200)  ,  DPDE ( 200 )  , 

1  EHL ( 200) , H ( 200, 3 ) , NEM ( 200 ) , NET (200) , PHL ( 200 )  ,  RHL ( 200 )  ,  SDT ( 200 )  , 

2  SHLC200) , TC200) , UC200) , YHLC200) , ZHLC200) 

NAMED  COMMON 
REAL  MU, MUM 

COMMON  / EQS/  EQSTA ( 6 ) , EQSTC ( 6 ) , EQSTD ( 6 ) , EQSTE ( 6 ) , EQSTQ ( 6 ) , 

1  EQSTH ( 6 ) , EQSTN ( 6) , EQSTS ( 6 ) , EQSTV ( 6 )  ,  CZQ(6)  ,  CWQ ( 6 )  ,  C2(6) 

COMMON  /MELT/  EMELT ( 6 , 8 ) , GMELT ( 6 , 8 ) , SPH ( 6 ) , THERM ( 6 , 8 ) 

COMMON  /RHO/  RHO ( 6 ) , RHOS ( 6 ) 

COMMON  /TSR/  TSR ( 6, 30 > , EXMAT ( 6, 20 ) , TENS( 6, 3) 

COMMON  /Y/  YO ( 6 ) , YADD ( 6 ) , MU ( 6 ) , MUM, YADDM 

COMMON  /IND/  I  EOS ( 6 ) ,  I NDK ( 20 ) , N ALPHA, NCMP ( 6 ) , NFR ( 6 ) , NPOR ( 6 ) , 

1  NDSC6) , NPR ( 6 ) , NC0NC6) , NVARC6) 

COMMON  /RAD/  SSTOPC  9) , START ( 9 ) , SDURM, SSTOPM, NSPEC, SSJ, JSS,  I PL0TC4) 

1  , XMAX ( 4 ) , XM I N ( 4 ) , YMAX ( 4 ) , YM I N ( 4 ) ,  I  A ( 7 ) ,  I T I TLE ( 24 ) , NARZ, TARZ 

COMMON  /PES/  l.VMAX,LVTOT,LVAR(  200),  COM  (4000) 

COMMON  /ESC/  ESC ( 6 , 20 ) 

DATA  MM/O/ 


$  LSUB (7) =1 
REDUCTION  AND 


$ 

OLD 


C  ABORT  FOR  NEGATIVE  DENSITY 

IF  (DH  . QT .  0. )  GO  TO  25 
WRITE  (6,4990)  N , J , DH , T I  ME 
C  COMPUTE  THERMAL  STRENGTH 

25  F= 1 . 

IF  (N  . EQ.  0)  GO  TO  30 
IF  (MM  .EQ.  1 000#M+N )  GO  TO  30 
IF  ( THERM ( M, 1 )  . EQ .  0.)  GO  TO  27 

EMELT (M, 1 )= THERM ( M, 6 ) + ( THERM(M, 1 ) 

1  /THERM ( M, 2 ) ) 

27  MM= 1 000*M+N 

IF  ( THERM (M, 3)  . EQ .  0.)  GO  TO  30 

EQSTE ( M ) = THERM (M, 8) +( THERM (M, 3) -THERM (M, 8) ) *EXP( ( 

1  /THERM ( M , 4 ) ) 

30  IF  (EH  .LT.  EMELT ( M ) )  IE=1 

M  .AND.  IE  .EQ.  1 )  H(J,3)=5R 
E20 )  GO  TO  34 
)  GO  TO  33 


RETURN 

DEVIATOR 


STRESS 


THERM (M, 6) )*EXP( ( -T I ME+O . 5*DTNH ) 


T I ME+O . 5*DTNH) 


CALL  TMELT (1 , M, EH , F, FG ) 


IF  (EH  .LT.  EMELT ( M ) ) 

IF  ( H ( J , 3 )  .EQ.  5R 
IF  ( EMELT (M, 1 )  .GT.  1 , 

IF  ( THERM ( M , 1 )  . EQ ,  0, 

CALL  TMELT(0,M,EH,F, FG) 

IF  ( GMELT ( M, 1 )  .NE.  0. ) 

GO  TO  34 

33  CALL  FMELT ( 4 , M, EH,  F,  FG,  X ) 

34  IF  (F  .EQ.  0. )  H(J,3)=5R 
MUM=MU(M) *FG 

IF  (EXMAT(M,4) .NE.  0.)  MUM= ( MU ( M ) + ( DH ■ 

T(J)=TENS(M, 1 ) #F 

YADDM*YADD(M) 

CZJ=CZQ (M) 

CW J=CWQ ( M ) 


M 


RHOS(M) ) *EXMAT ( M, 4 ) )*FG 
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14 
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1  5 

PUFCOM 

1  6 

PUFCOM 

1  7 

PUFCOM 

1  8 
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HSTRESS 
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30 
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31 

HSTRESS 

32 

HSTRESS 

33 

HSTRESS 

34 

HSTRESS 

35 

HSTRESS 

36 

HSTRESS 

37 

HSTRESS 

38 

HSTRESS 

39 

HSTRESS 

40 

HSTRESS 

41 

HSTRESS 

42 

HSTRESS 

43 

HSTRESS 

44 

HSTRESS 

45 

HSTRESS 

46 
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SUBROUTINE  HSTRESS  (Continued) 


DUH=U ( J+1 ) -U( J) 

HSTRESS 

DUHM  =  DUH 

HSTRESS 

DT - 0 . 5*(DTN+DTNH) 

HSTRESS 

IF  (NALPHA  .GT.  1)  DUHM= -2 . *DX/DH* ( DH-DOLD ) / ( DTN+DTNH ) 

HSTRESS 

c 

HSTRESS 

c 

STRAIN  CALCULATIONS  AND  DEFINITION  OF  DEVIATOR  STRESSES  FROM 

HSTRESS 

c 

FROM  PREVIOUS  CYCLE . STRA I  NS  AND  STRESS  DEVIATORS  ARE 

HSTRESS 

c 

POSITIVE  IN  TENSION. 

HSTRESS 

TXY  =  0 . 

HSTRESS 

ROT  =  0 . 

HSTRESS 

K=  1 

HSTRESS 

DROT  =  0 . 

HSTRESS 

EXY=0. 

HSTRESS 

EV= -2 . * ( DH-DOLD ) / ( DH+DOLD ) 

HSTRESS 

SDH=SHL ( J ) -PHL ( J ) 

HSTRESS 

SX= -SDH 

HSTRESS 

IF  (N  .LE.  1)  EXEN  =  EYEN  =  EZEN  =  0 . 

HSTRESS 

IF  ( NSCRB ( 6 )  .EQ.  0  . OR . MOD ( N , NED I T )  . NE .  1 )  GO  TO  45 

HSTRESS 

DXO=XO( J+1 ) -X0( J) 

HSTRESS 

EXEN= ( DX-DXO ) /DXO 

HSTRESS 

IF  (NALPHA  .EQ.  1 )  GO  TO  45 

HSTRESS 

XOS=XO( J+1 ) +X0 ( J ) 

HSTRESS 

EYEN=(X( J+1 )+X( J) -XOS)/XOS 

HSTRESS 

45 

CONTINUE 

HSTRESS 

GO  TO  (50, 60, 70)NALPHA 

HSTRESS 

C 

PLANAR  GEOMETRY 

HSTRESS 

50 

EX  =  EV 

HSTRESS 

EY  =  0 . 

HSTRESS 

EZ  =  0. 

HSTRESS 

SY  =  SDH/2 . 

HSTRESS 

SZ  =  SY 

HSTRESS 

GO  TO  80 

HSTRESS 

C 

CYLINDRICAL  GEOMETRY 

HSTRESS 

60 

EX=DUH#DT/DX 

HSTRESS 

EY  =  EV-EX 

HSTRESS 

EZ  =  0 . 

HSTRESS 

SY  =  -SDT ( J ) 

HSTRESS 

SZ= - ( SX+SY ) 

HSTRESS 

GO  TO  80 

HSTRESS 

0 

SPHERICAL  GEOMETRY 

HSTRESS 

70 

EX=DUH*DT/DX 

HSTRESS 

EY  s ( EV-EX ) /2 . 

HSTRESS 

EZ  =  EY 

HSTRESS 

SY  =  SDH/2 . 

HSTRESS 

SZ  =  SY 

HSTRESS 

EZEN  =  EYEN 

HSTRESS 

80 

CONTINUE 

HSTRESS 

IF  ( NSCRB ( 6 )  .EQ.  0  .OR.  MOD( N, NED  I T)  . NE .  1)  GO  TO  100 

HSTRESS 

TCX=PHL( J) -SX  S  TCY=PHL( J) -SY  S  TCZ= PHL ( J ) -SZ 

HSTRESS 

ECXEN= -EXEN  S  ECYEN= -EYEN  S  ECZEN= -EZEN 

HSTRESS 

PRINT  81 , N, J, TCX, TCY , TCZ, PHL ( J ) , ECXEN, ECYEN, ECZEN 

HSTRESS 

81 

FORMAT ( *  N ,  J  =  #  2 1  4  ,  #  TCX, TCY, TCZ, PHL=* 1 P4E1 0 . 3, *  ENG.  STRAINS 

HSTRESS 

1  ECX, ECY , ECZ=  #3E1 0.3) 

HSTRESS 

C 

HSTRESS 

1 

C 

****  ROUTES  FOR  COMPOSITE,  POROUS,  AND  FRACTURE  MODELS  **#* 

HSTRESS 

1 

C 

HSTRESS 

1 

100 

IF  ( NCMP ( M ) +NFR ( M ) +NPOR ( M )  . EQ .  0)  GO  TO  200 

HSTRESS 

1 

IF  (NCMP(M)  .EQ.  0)  GO  TO  130 

HSTRESS 

1 

C 

HSTRESS 

1 

C 

ROUTE  FOR  COMPOSITE  MODEL 

HSTRESS 

1 

C 

HSTRESS 

1 

C 

--  REBAR  -- 

HSTRESS 

1 

L=LVAR ( J ) 

HSTRESS 

1 

CALL  REBAR ( 1,5,J,JjM,N,H(Jj1)jDH, DOLD , SX, SY , SZ , TXY, EH, PHL ( J ) , EX, 

HSTRESS 

1 

1 EY , EZ, EXY , F, 0 . , 0 . , ESC, COM(L) , C0M(L+1 ) , C0M(L+3) , NEM ( J ) , NET ( J ) , 

HSTRESS 

1 

2  YHL ( J ) , COM ( L+2 ) , 0 ) 

HSTRESS 

1 

SDH= -SX 

HSTRESS 

1 

SDT ( J ) = -SY 

HSTRESS 

1 

GO  TO  400 

HSTRESS 

1 

C 

ROUTE  FOR  POROUS  MODEL 

HSTRESS 

1 

130 

IF  (NPOR(M)  .EQ.  0)  GO  TO  160 

HSTRESS 

1 

I F ( NPOR ( M )  .EQ.  3)  GO  TO  135 

HSTRESS 

1 

IF  ( H ( J , 1 )  .GE.  SOLID)  GO  TO  200 

HSTRESS 

1 

IF  (F  .GT.  0. )  GO  TO  135 

HSTRESS 

1 

H(J,1)=S0LID  $  GO  TO  200 

HSTRESS 

1 
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67 
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SUBROUTINE  HSTRESS  (Continued) 


135 

CONTINUE 

HSTRESS 

122 

NPORM=NPOR ( M ) 

HSTRESS 

1  23 

GO  TO  (140,145,150,155)  NPORM 

HSTRESS 

1  24 

C 

HSTRESS 

1  25 

C 

--  POREQST  -- 

HSTRESS 

1  26 

140 

CALL  POREQST (1 , 5 , M, CHL ( J ) , DH , DOLD, EH, EOLD, F, PHL ( J ) , CZJ , CW J , H ( J , 1 ), 

HSTRESS 

127 

1  DPDE(M) , EQSTC(M) , EQSTD(M) , EQSTG(M) , EQSTS (M ) , MUM, RHOS(M) , 

HSTRESS 

1  28 

2  YADDM, NDS(M) ,NPR(M) , J) 

HSTRESS 

1  29 

GO  TO  310 

HSTRESS 

1  30 

145 

CONTINUE 

HSTRESS 

1  31 

C 

HSTRESS 

1  32 

C 

--  PORHOLT  -- 

HSTRESS 

133 

CALL  PORHOLT ( 1 , 5,M, CHL ( J ) , DH, DOLD, EH, EOLD, F, PHL ( J ) , H ( J , 1 ) , J, 

HSTRESS 

134 

1  DPDE ( J ) , EQSTC(M) , MUM, YADDM, RHOS(M) , DT) 

HSTRESS 

135 

GO  TO  310 

HSTRESS 

1  36 

150 

NPRM  =  NPR (M ) + 1 

HSTRESS 

1  37 

C 

HSTRESS 

1  38 

C 

--  PEST  -- 

HSTRESS 

1  39 

L=LVAR ( J ) 

HSTRESS 

140 

MUM= 1 . 333*MUM 

HSTRESS 

141 

CALL  PEST (2, 5, NPRM, H( J, 1 ) , J , T ( J ) , DT , M, CHL ( J ) , DH, 

HSTRESS 

142 

1  DOLD, RHOS(M) , COM ( L ) , PHL ( J ) , C0M(L+1 ) , 

HSTRESS 

143 

2  COM ( L+2 ) , EH, EOLD, F, EQSTC(M) , EQSTD(M) , EQSTS ( M ) , 

HSTRESS 

144 

3  EQSTG(M) , MUM, YADDM, COMCL+3) , COMCL+4) , CZJ, 

HSTRESS 

145 

4  CWJ,  EQSTH(M) , EQSTE(M) , EQSTN(M) , EQSTV(M) , 

HSTRESS 

146 

5  EQSTA(M) , DPDDC J) , DPDE ( J ) , N) 

HSTRESS 

147 

MUM=  0.75  *  MUM 

HSTRESS 

148 

GO  TO  300 

HSTRESS 

149 

155 

SX=SX -PHL ( J ) 

HSTRESS 

150 

SY=SY - PHL ( J ) 

HSTRESS 

151 

SZ=SZ-PHL ( J ) 

HSTRESS 

152 

C 

HSTRESS 

153 

C 

--  CAP 1 

HSTRESS 

1  54 

C 

SX , SY , SZ  ARE  TOTAL  STRESSES  POSITIVE  IN  TENSION 

HSTRESS 

1  55 

157 

CALL  CAP1 (LSUBC8) ,  I N, M, N, H ( J , 1 ) , DH, DOLD, EH, EX, EY, EZ, EXY , F, 

HSTRESS 

1  56 

1  EQSTG(M) , RHOS(M) , SX, SY,SZ, TXY , NEM ( J) ,K, J, NET ( J ) ) 

HSTRESS 

157 

PHL ( J ) = - ( SX+SY+SZ) /3 . 

HSTRESS 

1  58 

SDH3 -SX-PHL ( J ) 

HSTRESS 

159 

SDT ( J ) = -SY-PHL ( J ) 

HSTRESS 

160 

GO  TO  400 

HSTRESS 

161 

C 

ROUTES  FOR  FRACTURE  MODELS 

HSTRESS 

162 

1  60 

NFRM=NFR (M ) +1 

HSTRESS 

163 

GO  TO (200, 170, 175, 180, 180, 195)NFRM 

HSTRESS 

1  64 

C 

HSTRESS 

1  65 

C 

--  DFRACT  -- 

HSTRESS 

1  66 

1  70 

IF(PHLCJ)  .GT.  TSR ( M, 5 )  .AND.  H(J,3)  . LT .  3)G0  TO  200 

HSTRESS 

167 

CALL  DFRACT (SX, SY, SZ, TXY, EX, EY, EZ,  EXY, PHL ( J )  ,  NEM ( J )  ,  NET( J )  , 

HSTRESS 

1  68 

1  DH, DOLD, DT, EOLD, EH, EQSTC(M) , EQSTG(M) , MUM, RHOS(M) , TSR, YHL ( J ) , 

HSTRESS 

1  69 

2  YADDM, F,M,J,K,DROT) 

HSTRESS 

1  70 

SHL (  J )  3 -SX+PHL ( J ) 

HSTRESS 

171 

SDT ( J ) = -SY 

HSTRESS 

1  72 

H  ( J ,  3 )  =  3 

HSTRESS 

173 

GO  TO  410 

HSTRESS 

1  74 

C 

HSTRESS 

1  75 

C 

--  FRAG  -- 

HSTRESS 

1  76 

175 

IF  ( H ( J , 3 )  . GE .  3)  GO  TO  177 

HSTRESS 

177 

STENS3AMAX 1 ( SX ,  SY ,  SZ ) 

HSTRESS 

178 

IF  ( -STENS+PHL ( J )  .GT.  TSR(M,5))  GO  TO  200 

HSTRESS 

179 

H  (  J  ,  3  )  3  3 

HSTRESS 

1  80 

LVAR ( J ) =LVMAX 

HSTRESS 

181 

LVMAX  =  LVMAX  +  NVAR ( M ) 

HSTRESS 

182 

IF  (LVMAX  .LE.  LVTOT+1 )  GO  TO  177 

HSTRESS 

1  83 

LSUB ( 7 ) 3 1 

HSTRESS 

184 

PRINT  1177, N,J, TIME 

HSTRESS 

1  85 

1  177 

’  FORMAT ( *  FRAG  EXCEEDED  STORAGE  AT  N=*I4,*  J=*I3,*  T I ME  =  # 1  PE 1 0 . 3 ) 

HSTRESS 

1  86 

177 

LS=  1 

HSTRESS 

1  87 

IF  ( MOD ( N, NED  I T )  . EQ .  0)  LS32 

HSTRESS 

188 

L=LVAR ( J ) 

HSTRESS 

1  89 

CALL  FRAG ( LS, 5,MjJ,J,N,H(J,3)j  EQSTC(M)  ,  DH, DOLD, DT,  EH,  EOLD,  EX,  EY, 

HSTRESS 

1  90 

1  EXY , F , NEM ( J ) , MUM , EQSTG ( M ) , RHOS ( M ) , ROT , DROT , PHL ( J ) , SX , SY , TXY , 

HSTRESS 

191 

2  YHL ( J ) , EXMAT (M, 1 ) , TSR , COM ( L ) , COM ( L+5 ) , COM ( L+ 1 0 ) ,  COM ( L  + 1  5 )  , 

HSTRESS 

192 

3  COM ( L+20 ) ) 

HSTRESS 

193 

SDH= -SX 

HSTRESS 

194 

SDT ( J ) 3 -SY 

HSTRESS 

195 

LSUB ( 1 2 ) = 1 

HSTRESS 

196 

260 


SUBROUTINE  HSTRESS  (Continued) 


GO  TO  400 

HSTRESS 

1  97 

c 

HSTRESS 

1  98 

c 

--  SHEAR 1  -- 

HSTRESS 

1  99 

1  80 

I FCHC Jj 3) -2)  177,  181, 183 

HSTRESS 

200 

1  81 

IF(NFRCM)  ,EQ.  3)G0  TO  183 

HSTRESS 

201 

STENS= AMAX1 (SX,SY,SZ) 

HSTRESS 

202 

I F ( -STENS  .LT.  TSRCM, 5 ) *TSR(M, 9)  .AND.  -STENS+PHL ( J )  . LT .  TSR (M, 8) 

HSTRESS 

203 

1  ) GO  TO  177 

HSTRESS 

204 

1  83 

LS  =  2 

HSTRESS 

205 

IF  ( MOD ( N, NED  I T )  . EQ .  0)  LS  =  3 

HSTRESS 

206 

L  =  LVAR  C  J ) 

HSTRESS 

207 

CALL  SHEAR2C  LS, 5, M, J, J , H( J , 3) , SX, SY , SZ, TXY, PHLC J) , COMCL) , DH, DOLD, 

HSTRESS 

208 

1  DT, EH, EOLD, C0M(L+1 ) , EMELT CM , 1 ) , COM ( L+2 ) , EX J EY , EZ , EXY , F , YHL C J ) , 

HSTRESS 

209 

2  COM ( L+3 ) , ROT, ROT, ESC, COMCL+4) ) 

HSTRESS 

210 

SDH= -SX 

HSTRESS 

21  1 

SDT ( J ) = -SY 

HSTRESS 

212 

GO  TO  400 

HSTRESS 

21  3 

C 

HSTRESS 

214 

C 

--  BFRACT  -- 

HSTRESS 

215 

1  95 

I F  C  H ( J , 3 )  .NE.  2) GO  TO  197 

HSTRESS 

216 

STENS=AMAX1 (SX,SY,SZ) 

HSTRESS 

217 

IF  (N  .EQ.  0)  GO  TO  200 

9/12/79 

1  2 

IF  ( -STENS  . GT .  TSR( M, 5) *TSR ( M, 9)  .OR.  -STENS+PHL ( J )  , GT .  TSR(M,8) 

HSTRESS 

218 

1  )G0  TO  200 

HSTRESS 

219 

H  (  J  ,  3  )  =  1 

HSTRESS 

220 

1  97 

SY  = -SY 

HSTRESS 

224 

sz=-sz 

HSTRESS 

225 

LS  =  LSUB (12) 

HSTRESS 

226 

IF  (LS  .NE.  0  .AND.  MOD ( N , NED  I T )  . EQ .  0)  LS  =  2 

HSTRESS 

227 

L=LVAR ( J ) 

HSTRESS 

228 

CALL  BFRACT ( LS , SDH, SY , SZ, TXY , -EX, -EY, -EZ, -EXY, PHL( J) , NEM ( J ) , NETC J) 

HSTRESS 

229 

1  , RHOS ( M ) /DH, RHOS ( M ) /DOLD , DT, EOLD , EH , EQSTC ( M ) , EQSTG ( M ) , MUM , TSR, 

HSTRESS 

230 

2  YHL  C  J ) , YADDM, F, 1 , J,M, N, RHOS(M) , DROT, ROT, COMCL) , COMCL  +  1  ) , COMCL+6) 

HSTRESS 

231 

3  ) 

HSTRESS 

232 

SDT ( J  )  = -SY 

HSTRESS 

233 

1  99 

LSUB ( 1 2 ) -  1 

HSTRESS 

234 

GO  TO  400 

HSTRESS 

235 

C 

HSTRESS 

236 

C 

****  ROUTES  FOR  PRESSURE  CALCULATION  **** 

HSTRESS 

237 

C 

HSTRESS 

238 

200 

NPRM  =  NPR ( M ) + 1 

HSTRESS 

239 

GO  TO  (270,220,230,240,250,255,260,270)  NPRM 

HSTRESS 

240 

C 

EQUATION  OF  STATE  FOR  EXPLOSION  PRODUCTS 

HSTRESS 

241 

220 

IF  (NEMCJ)  .GE.  0.999999)  GO  TO  270 

HSTRESS 

242 

QH  =  0 .  $  IFCDUHM  . LT .  -1.)  QH= ( CZJ  *  DUHM-CW J  *CHL ( J ) ) *  DUHM*DH 

HSTRESS 

243 

L  =  LVAR ( J ) 

HSTRESS 

244 

CALL  EXPLODE (3, 5,M, EHL, DHL, DOLD, PHL, SHL, NEM, X, J , QH , T I  ME , DT ) 

HSTRESS 

245 

EH  =  EHL ( J ) 

HSTRESS 

246 

GO  TO  305 

HSTRESS 

247 

C 

SIMPLE,  EXTENDED  EQUATION  OF  STATE 

HSTRESS 

248 

230 

CALL  ESA ( 1 , 5, M, CHL ( J ) , DH, EH, PHL  C  J ) , DPDDC  J ) , DPDE ( J ) ) 

HSTRESS 

249 

GO  TO  300 

HSTRESS 

250 

C 

PHILCO-FORD  EQUATION  OF  STATE 

HSTRESS 

251 

240 

CALL  EQSTPFC 1 , 5, M, CHL ( J ) , DH , EH, PHL ( J ) ) 

HSTRESS 

252 

GO  TO  300 

HSTRESS 

253 

C 

VARIABLE  MODULI  EQN .  OF  STATE 

HSTRESS 

254 

C 

(IMPLEMENTED  FOR  PLANAR  AND  SPHERICAL  CASES  ONLY) 

HSTRESS 

255 

250 

EPS  =  EMU e ALOG ( DH/RHO ( M )  ) 

HSTRESS 

256 

IF  (NALPHA  .NE.  3)  GO  TO  252 

HSTRESS 

257 

L  =  LVAR ( J ) 

HSTRESS 

258 

IF  (COMCL)  .EQ.  0.)  COM(L)=X(J) 

HSTRESS 

259 

EPS  =  EMU  +  3 . * ALOG ( (X(J)+U(J)*DTNH/2.  ) /COMCL ) ) 

HSTRESS 

260 

252 

NEMCJ ) =EMU 

HSTRESS 

261 

NETC J ) =EPS 

HSTRESS 

262 

CALL  HYPO ( 1 , I N, M, CHL ( J ) , DH, EMU, COM ( L+1 ) , EPS, COM ( L+2 ) , J, PHL ( J ) , SDH ) 

HSTRESS 

263 

GO  TO  400 

HSTRESS 

264 

C 

LLL*S  3-PHASE  EQUATION  OF  STATE  OF  ROYCE 

HSTRESS 

265 

255 

CALL  GRAY ( 1 , I N, M, MUM , EMELT CM, 1 ) ,DH , EH, CHL ( J ) , PHL ( J ) , DPDDC J) , 

HSTRESS 

266 

1  DPDE ( J ) , H ( J , 1 ) ) 

HSTRESS 

267 

GO  TO  305 

HSTRESS 

268 

C 

SAND  I A  TABULAR  EQUATION  OF  STATE 

HSTRESS 

269 

260 

CALL  EOSTABC 1  ,  I N, DH, EH, PHLC J) ) 

HSTRESS 

270 

GO  TO  300 

HSTRESS 

271 

C 

M I E-GRUNE I  SEN  AND  PUFF  EXPANSION  EQUATIONS  OF  STATE 

HSTRESS 

272 

270 

CALL  EQSTC EH, DH, PHLC J) , M, CHL ( J ) , DPDDC J)  ,  DPDEC  J ) ) 

HSTRESS 

273 

261 


SUBROUTINE  HSTRESS  (Continued) 


c 

c 

c 

300 

C 

3D5 
31  D 
C 


31  2 


318 


C 

320 


323 


325 


C 

330 


C 

340 


C 

350 


****  ROUTES  FOR  DEVIATOR  STRESS  CALCULATION  **** 

IF  (MUM  .GT.  0.  .AND.  YHL(J)*F  .GT.  0.  .AND.  NPR(M)  .NE.  1)  GO  TO 
1  310 

MATERIAL  IS  MELTED  OR  HOTTER  -  NO  DEVIATOR  STRESS 
SDH=0.  $  GO  TO  4DD 
IF  (NDS(M)  .GT.  D)  GO  TO  32D 

COULOMB-MISES  YIELD  WITH  WORK  HARDENING 
IF  (NALPHA  .GT.  1)  GO  TO  312 
SDH=SDH - 1 . 333*MUM*EV 
GO  TO  318 

SDH = SDH - 2 . 0*MUM* ( EX-EV/3 . ) 

IF  (NALPHA  .NE.  2)  GO  TO  318 

SDT ( J ) =SDT ( J ) -1 . 333*MUM* (EV-1 . 5* EX) 

SN=SQRT ( 3 . *(SDH*SDH+SDT(J)*SDT(J)+SDH*SDT(J) ) ) 

IF  (SN  .LT.  (YHL( J)+EXMAT(M, 1 )*PHL( J) )*F)  GO  TO  400 
YHL( J ) = AMI N1 ( AMAX1 (SN, YHL(J) ) , YHL ( J ) +YADDM*ABS ( DH-DOLD ) ) 

EL= ( YHL ( J ) +EXMAT ( M , 1 ) *PHL ( J ) )*F/SN 

SDH=EL*SDH  S  SDT ( J ) = EL*SDT ( J )  $  GO  TO  400 

CONTINUE 

IF  (ABS(SDH)  .LT.  0.6667*(YHL(J) +EXMAT ( M, 1 )*PHL(J) )  *F)  GO  TO  400 
YHL  (  J  )  =  AM  I  N 1  (  AMAX1  (ABS(1  .  5*SDH  )  ,  YHL  (  J  )  )  ,  YHL  (  J  )  +YADDM*  ABS  (  DH  -  DOLD  )  ) 
SDH=S I GN ( 0 . 6667# ( YHL ( J ) + EXMAT ( M , 1 )*PHL( J) )*F,SDH) 

GO  TO  400 

PREPARE  FOR  COMPLEX  YIELD  MODELS 
DRHO=DH-DOLD 
OMUM=MUM 

COEF  = -2 . 0*MUM* ( EX-EV/3 .  ) 

IF  (NALPHA  .EQ.  2)  GO  TO  323 
DRHO=COEF# ( DH+DOLD) /2 . 667/MUM 
GO  TO  325 
DSR=SDH+COEF 

DST  =  SDT (  J  )  -  1  . 333*MUM* ( EV - 1  . 5*EX) 

SNE  =  0 . 66667*SQRT ( 3 . * ( DSR*DSR+DST*DST+DSR*DST) ) 

SNO=0 . 66667*SQRT( 3. * ( SDH*SDH+SDT ( J ) *SDT ( J ) +SDT ( J ) *SDH ) ) 
COEF=SNE-SNO 

DRHO=COEF* ( DH+DOLD )/2. 667/MUM 
SDHO=SDH  $  SDH=SNO 
CONTINUE 
NDSM=NDS ( M ) 

GO  TO  (330,340,340,330,350,360,370)  NDSM 

ONE-  AND  TWO-PARAMETER  RELAXATION  MODELS  (NDS=1,  4) 

CALL  RELAX (  H  (  J  ,  3  ) ,SDH,YHL(J) , DRHO , COEF, N, J , M, NEM ( J )  ,  NET ( J )  ,  DT, 

1  TSR, YADDM, YO(M) , NDSM) 

GO  TO  390 

BAND  AND  GILMAN  RELAXATION  MODELS  (NDS=2,  3) 

CALL  BANDRLX ( H ( J , 3 ) , SDH, YHL( J) , DRHO, COEF, N, J,M, NEM ( J ) , NET ( J ) , DT, 

1  TSR, MUM, YADDM, NDSM) 

GO  TO  390 

BAUSCHINGER  EFFECT  MODEL  (NDS=5) 

MUM= ( MU ( M ) +TSR ( M, 1 9 ) * ( DH/RHO ( M ) -  1  .  ))*F 
COEF  =  2 . #MUM#DRHO/( DH+DOLD) 

CALL  BAUSCHI ( H ( J , 3 ) , SDH , COEF, NEM ( J ) , YHL ( J ) , NET ( J ) , TSR ( M, 15), TSR ( M , 
1  16) ,TSR(M, 17), TSR ( M, 18), MUM) 

CSQ  =  CHL (  J  )  *  *  2+AMAX1  (0.  ,  ( MUM-OMUM ) *2 . /(DH+DOLD) ) 

CHL ( J ) =0 . 5* ( CSQ/CHL ( J ) +CHL ( J ) ) 

GO  TO  390 


C  READ  RELAXATION  MODEL  FOR  BERYLLIUM  (NDS=6) 

360  CALL  STRES2 ( LSUB ( 13),0,H(J,3),M,J,N,DH, DOLD, RHOS(M) , SDH, MUM, F, DT, 
1  NEM ( J ) , NET ( J ) , TSR ) 

GO  TO  390 

C  NONLINEAR  WORK-HARDENING. 

370  SZ=-SZ 

CALL  EP ( 1 , M, N, SDH, SDT ( J) ,SZ, TXY , YHL ( J ) , -EX,  -EY,  -EZ, -EXY , MUM, 

1  NEM ( J ) ) 

C 

C  ****  ARTIFICIAL  VISCOSITY  AND  RESULTANT  STRESS  **** 

C 

39D  IF  (NALPHA  . NE .  2)  GO  TO  4DD 

C  ADJUSTMENTS  FOR  DEVIATORS  IN  CYLINDRICAL  CASE 

EL  =  SDH/SNE  $  SDH  =  EL*  DSR  $  SDT ( J ) =EL*DST 

400  SHL( J) =PHL( J)+SDH 

IF  ( H ( J , 1 )  .EQ.  SOLID  .AND.  (DH  /RH0S(M)-1.)  .GT.  D.)SHL(J)  = 

1  PHL ( J ) +SDH* ( 1 . -0. 5*EQSTG(M)*(DH/RH0S(M) -1 . )/AMAX1 (D. 01 , F) ) 


HSTRESS 

274 

HSTRESS 

275 

HSTRESS 

276 

HSTRESS 

277 

HSTRESS 

278 

HSTRESS 

279 

HSTRESS 

280 

HSTRESS 

281 

HSTRESS 

282 

HSTRESS 

283 

HSTRESS 

284 

HSTRESS 

285 

HSTRESS 

286 

HSTRESS 

287 

HSTRESS 

288 

HSTRESS 

289 

HSTRESS 

290 

HSTRESS 

291 

HSTRESS 

292 

HSTRESS 

293 

HSTRESS 

294 

HSTRESS 

295 

HSTRESS 

296 

HSTRESS 

297 

HSTRESS 

298 

HSTRESS 

299 

HSTRESS 

300 

HSTRESS 

301 

HSTRESS 

302 

HSTRESS 

303 

HSTRESS 

304 

HSTRESS 

305 

HSTRESS 

306 

HSTRESS 

307 

HSTRESS 

3D8 

HSTRESS 

309 

HSTRESS 

310 

HSTRESS 

31  1 

HSTRESS 

312 

HSTRESS 

31  3 

HSTRESS 

314 

HSTRESS 

315 

HSTRESS 

316 

HSTRESS 

317 

HSTRESS 

318 

HSTRESS 

319 

HSTRESS 

320 

HSTRESS 

321 

HSTRESS 

322 

HSTRESS 

323 

HSTRESS 

324 

HSTRESS 

325 

HSTRESS 

326 

HSTRESS 

327 

HSTRESS 

328 

HSTRESS 

329 

HSTRESS 

330 

HSTRESS 

331 

HSTRESS 

332 

HSTRESS 

333 

HSTRESS 

334 

HSTRESS 

335 

HSTRESS 

336 

HSTRESS 

337 

HSTRESS 

338 

HSTRESS 

339 

HSTRESS 

340 

HSTRESS 

34  1 

HSTRESS 

342 

HSTRESS 

343 

HSTRESS 

344 

HSTRESS 

345 

HSTRESS 

346 

HSTRESS 

347 

HSTRESS 

348 
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SUBROUTINE  HSTRESS  (Concluded) 


410 

RH=SHL ( J )  $  CEF=CHL ( J ) 

HSTRESS 

349 

IF  ( DUHM  .  GE.  -1.)  GO  TO  450 

HSTRESS 

350 

CF=CWJ-CZJ*DUHM/CHL( J) 

HSTRESS 

351 

CEF  =  CHL ( J ) x ( 1  . +CF  * (1  . +0. 5*CF) ) -DUH/2. 

HSTRESS 

352 

IFCCF  .GT.  1.0)  CEF  =  CHL ( J ) * ( 2 . *CF+0. 5/ CF ) -DUH/2 . 

HSTRESS 

353 

GO  TO  470 

HSTRESS 

354 

450 

CF=C2 ( M ) 

HSTRESS 

355 

470 

RH=SHL ( J ) -CF*CHLC J )*DUHM*DH 

HSTRESS 

356 

IF  (RH.LT.O.  .AND.  F.LE.O.  .AND.  NSEPRAT . EQ . 0 )  RH=SHL ( J ) =  PHL C J ) =0 . 

HSTRESS 

357 

C 

SPALL  PROVISIONS 

HSTRESS 

358 

IF  (NFR(M)  .GT.  0)  GO  TO  550 

HSTRESS 

359 

SHLSV=SHL ( J ) 

HSTRESS 

360 

PHLSV=PHL ( J ) 

HSTRESS 

361 

IF  (RH  .LT.  T ( J ) )  GO  TO  515 

HSTRESS 

362 

I F ( NALPHA  .EQ.  2)  GO  TO  505 

HSTRESS 

363 

IF  (PHL(J)  -SDH/2.  .LT.  TCJ))  GO  TO  520 

HSTRESS 

364 

GO  TO  550 

HSTRESS 

365 

505 

IFCPHLCJ)  +SDTCJ)  .LT.  TCJ))  GO  TO  525 

HSTRESS 

366 

IF(2. *PHL ( J ) -SDT(J) -SHL ( J ) . LT . T ( J ) ) GO  TO  530 

HSTRESS 

367 

GO  TO  550 

HSTRESS 

368 

515 

SHL( J) =PHL( J) =RH=0. 

HSTRESS 

369 

GO  TO  535 

HSTRESS 

370 

C 

SPALL  BY  LATERAL  STRESS, NALPHA= 1 J 3 

HSTRESS 

371 

520 

RF  = ( 3 . *PHL ( J ) -SHL ( J ) )/2. /CEQSTCCM)+1  . 333*MUM) 

HSTRESS 

372 

DP=EQSTC(M)*RF 

HSTRESS 

373 

DS=MUM*RF 

HSTRESS 

374 

Q  =  RH-SHL ( J ) 

HSTRESS 

375 

SHLC J)=SHL( J) -DP+DS/2. 

HSTRESS 

376 

RH=SHL ( J ) +Q 

HSTRESS 

377 

PHL( J)=PHL( J) -DP 

HSTRESS 

378 

GO  TO  535 

HSTRESS 

379 

C 

SPALL  BY  THETA  STRESS, NALPHA=2 

HSTRESS 

380 

525 

RF= ( PHL ( J ) +SDT ( J ) ) / ( EQSTC ( M ) + 1 . 333*MUM) 

HSTRESS 

381 

DP=EQSTC(M) *RF 

HSTRESS 

382 

DS=MUM*RF 

HSTRESS 

383 

PHL ( J ) =PHL ( J ) -DP 

HSTRESS 

384 

Q  =  RH-SHL ( J ) 

HSTRESS 

385 

SHL( J) =SHL( J) -DP+DS/2. 

HSTRESS 

386 

RH=SHL (  J )  +Q 

HSTRESS 

387 

3DT ( J ) = -PHL ( J ) 

HSTRESS 

388 

GO  TO  535 

HSTRESS 

389 

C 

SPALL  BY  Z  STRESS,  NALPHA=2 

HSTRESS 

390 

530 

RF  =  ( 2  .  *PHL(  J)  -SDT  (  J  )  -SHL  (  J  )  )/(  EQSTC  ( M )  +1 . 333*MUM  ) 

HSTRESS 

391 

DP  =  EQSTC ( M ) *RF 

HSTRESS 

392 

DS=MUM*RF 

HSTRESS 

393 

Q=RH-SHL ( J ) 

HSTRESS 

394 

PHL(J)=PHL(J) -DP 

HSTRESS 

395 

SHLC J) =SHL( J) -DP+DS/2. 

HSTRESS 

396 

SDT ( J ) =SDT ( J ) +DS/ 2 . 

HSTRESS 

397 

RH=SHL ( J ) +Q 

HSTRESS 

398 

535 

CONTINUE 

HSTRESS 

399 

PRINT  4992, J, N, SHLC J) , PHL ( J ) , RH, Q, SDT  C  J ) , DP, DS, SHLSV, PHLSV 

HSTRESS 

400 

4992 

FORMAT ( *  - J=* I 3, *  N=*I3,*  SHL, PHL, RH,Q=*1P4E1 1 . 3, *  SDT,DP,DS=* 

HSTRESS 

401 

1  1P3E11.3/*  SHLSV , PHLSV  =  * 1 P2E 1 1  . 3 ) 

HSTRESS 

402 

IF  ( H ( J , 2)  .GT.  0  .AND.  H(J,2)  .LT.  77B)  GO  TO  550 

HSTRESS 

403 

IF  ( H ( J , 2 )  .NE.  NORMAL)  GO  TO  550 

HSTRESS 

404 

H  C  J , 2 ) =  NSPALL=  NSPALL+ 1 

HSTRESS 

405 

550 

CONTINUE 

HSTRESS 

406 

RETURN 

HSTRESS 

407 

4990 

FORMAT ( 20H  STOP  IN  HSTRESS,  N=I4,4H,  J=I4,4H,  D=1PE10.3, 

HSTRESS 

408 

1  7H,  T I ME= 1  PEI  0.3) 

HSTRESS 

409 

END 

HSTRESS 

410 
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SUBROUTINE  HYDRO 


SUBROUTINE  HYDRO 

HYDRO 

2 

c 

HYDRO 

3 

c 

SUBROUTINE  CONTROLS  THE  MAIN  CALCULATION  CYCLE 

HYDRO 

4 

c 

*  CONTAINS  6  PATHS  - 

HYDRO 

5 

c 

1.  NORMAL  -  COORDINATES  WITHIN  MATERIAL 

HYDRO 

6 

c 

2.  INTERFACE  -  INTERFACE  BETWEEN  MATERIALS 

HYDRO 

7 

c 

3.  INTERFACE  SPALL  -  SEPARATED  INTERFACE  BETWEEN  MATERIA 

HYDRO 

6 

c 

4.  MIRROR  -  FIRST  COORDINATE  FOR  A  SYMMETRIC  IMPACT 

HYDRO 

9 

c 

5.  PRESSURE  -  PRESSURE  HISTORY  APPLIED  AT  FRONT  (J«1) 

HYDRO 

10 

c 

6.  LEFT  INTERFACE  -  DUMMY  PATH 

HYDRO 

1  1 

c 

*  CALLS  HAFSTEP  FOR  HALFSTEP  CALCULATIONS  AT  EACH  COORDINATE 

HYDRO 

1  2 

c 

*  CHECKS  FOR  SPALLING  AND  RECOMBINATION 

HYDRO 

1  3 

c 

*  COMPUTES  MINIMUM  PERMITTED  TIME  STEP  FOR  NEXT  CYCLE 

HYDRO 

14 

c 

INPUT  -  DTNH j  DTN ,  FI RST j  NCYCS . 

HYDRO 

1  5 

c 

HYDRO 

1  6 

c 

NAMED  COMMON 

EQSTCOM 

2 

REAL  MU j  MUM 

EQSTCOM 

3 

COMMON  /EQS/  EQSTA ( 6 ) , EQSTC( 6) , EQSTD (  6)  , EQSTE ( 6) J EQSTGC  6) , 

EQSTCOM 

4 

1  EQSTH ( 6 ) , EQSTNC6) , EQSTS ( 6 ) , EQSTV(6) , C2QC6) , CWQC6) , C2(6) 

EQSTCOM 

5 

COMMON  /MELT/  EMELT ( 6 , 6) , GMELT ( 6 , 6 ) J SPH ( 6 ) , THERM ( 6 , 6 ) 

EQSTCOM 

6 

COMMON  /RHO/  RHO ( 6 ) j  RHOS ( 6) 

EQSTCOM 

7 

COMMON  /TSR/  TSR ( 6 , 30 ) , EXMAT ( 6 , 20 ) , TENS ( 6 , 3 ) 

EQSTCOM 

6 

COMMON  /Y/  Y0(6) , YADD ( 6 ) , MU ( 6 ) , MUM , YADDM 

EQSTCOM 

9 

COMMON  / I ND/  1  EOS (  6  )  ,  1 NDK (  20 )  , NALPHA , NCMP ( 6)  ,  NFR ( 6)  , NPOR ( 6 ) , 

INDCOM 

2 

1  NDS ( 6) , NPR ( 6) j NCON ( 6 ) , NVAR ( 6 ) 

I NDCOM 

3 

COMMON  /RAD/  SSTOPC  9 ) , START ( 9 ) , SDURM, SSTOPM, NSPEC, SS J , JSS,  I  PLOT ( 4 ) 

RADCOM 

2 

1  , XMAX ( 4 ) j  XM I N ( 4 ) j  YMAX ( 4  ) , YM I N ( 4 ) ,  1A(7),  I T I TLE (  24 ) , NARZ, TAR2 

RADCOM 

3 

c 

HYDRO 

20 

INTEGER  H j POROUS , PRESS , R 1 NTER , SOL  I D , SPALL 

PUFCOM 

2 

REAL  MATL, NEM, NET, NEMH, NETH 

PUFCOM 

3 

c 

MISCELLANEOUS 

PUFCOM 

4 

COMMON  AZER0C1 ) , CEF, CKS, DAVG, DELT I M , D 1 SCPT (  1 0) , DOLD, DRHO , DTMAX , 

PUFCOM 

5 

1  DTMI N, DTN, DTNH, DU, DX, EOLD, F, FAC, Fl RST, J, JCYCS, J I NI T, 

PUFCOM 

6 

2  JFIN, JREZ0NC1 5) , JSMAX, JSTAR, JTS, LSUB C 30 ) , M, MAXPR ( 30 ) , N, NCYCS, 

PUFCOM 

7 

3  NED  I T, NPERN, NR, NREZON , NSCRBC6) , NSEPRAT, NSPALL , NTEDT , 

PUFCOM 

6 

4  NTEX, NTRC1 5) , POLD , P6 ( 20 ) , R ( 30 ) , RLAST , SLAST, SMAX, TED  I T ( 50 ) , 

PUFCOM 

9 

5  TF, TI ME, TJ, TREZON, TS, T6( 20) , ULAST, UOLD, UZERO, XLAST , XNOW, XOLD 

PUFCOM 

1  0 

1  , X JD I T ( 20 ) , MS 

PUFCOM 

1  1 

c 

HALFSTEP  VALUES 

PUFCOM 

12 

COMMON  DH, DHLAST , DUH, EH, PH, RH, RHLAST, SH, SHLAST, UH, UHLAST, XH, XHLAST 

PUFCOM 

1  3 

1  , NEMH, NETH 

PUFCOM 

14 

c 

CONDITION  INDICATORS 

PUFCOM 

15 

COMMON  I NF, LI NTER, MI RROR, NORMAL, POROUS, PRESS, R I NTER, SOLI D, SPALL 

PUFCOM 

16 

c 

CELL  LAYOUT 

PUFCOM 

17 

COMMON  DXXC30) , JBNDC30), JMATC30) , NAUTO, MATL C 6, 2) , NLAYER, NMTRLS, 

PUFCOM 

1  6 

1  THKC30) 

PUFCOM 

1  9 

c 

PUFCOM 

20 

c 

COORDINATE  ARRAYS 

COORDCOM 

2 

COMMON/COORD/XC  200) , X0C200) , CHL( 200) , DHL (200) , DPDD ( 200 ) , DPDE(200) , 

COORDCOM 

3 

1  EHL ( 200 ) , H ( 200, 3 ) , NEM ( 200 ) , NET ( 200 ) , PHL ( 200 ) , RHL ( 200 ) , SDT ( 200 ) , 

COORDCOM 

4 

2  SHLC200) , TC200) , U ( 200 ) , YHL ( 200 ) , ZHLC200) 

COORDCOM 

5 

c 

HYDRO 

23 

IF  (N  .  EG),  1  )  I  SPALL  =  0 

HYDRO 

24 

1 

DT  =  DTM I N= 1  . 

HYDRO 

25 

SMAX=0 . 

HYDRO 

26 

c 

####  ROUTINE  TO  RESET  DTNH  FOR  SPALL  CLOSURE  ***** 

HYDRO 

27 

IF  (NLAYER  .LE.  1  .OR.  I  SPALL  .EQ.  0)  GO  TO  62 

HYDRO 

26 

NLM1 =NLAYER-1 

HYDRO 

29 

DO  60  LLL= 1 , NLM1 

HYDRO 

30 

JB= JBND ( LLL ) 

HYDRO 

31 

IF  (JB  . GT .  JSTAR)  GO  TO  62 

HYDRO 

32 

IF  ( H( JB+1 , 2)  .NE.  SPALL)  GO  TO  60 

HYDRO 

33 

IF  (U(JB)  .EQ.  U ( JB+1 ) )  GO  TO  60 

HYDRO 

34 

DTSP= ( X ( JB+1 ) -X ( JB ) ) / ( U ( JB ) *U ( JB+1 )) 

HYDRO 

35 

IF  ( DTSP  .GT.  DTNH  .OR.  DTSP  .LT.  0.)  GO  TO  60 

HYDRO 

36 

DTNAT  =  AM  I N 1 ( ( X ( JB ) -X ( JB- 1  ) )/CHL( JB-1  ) , (X( JB+2) -X( JB+1 ) )/CHL( JB+1 ) ) 

HYDRO 

37 

DTNH=AM I N 1 ( DTNH, AMAX1 ( DTSP, 0 . 2*DTNAT ) ) -0 . 001 *DTNAT 

HYDRO 

36 

DTM I N»0 . 2* DTNAT 

HYDRO 

39 

NCYCS= 1 

HYDRO 

40 

60 

CONTINUE 

HYDRO 

41 

62 

CONTINUE 

HYDRO 

42 

c 

HYDRO 

43 

c 

OUTER  HYDRO  LOOP 

HYDRO 

44 

DO  1000  NN= 1 , NCYCS 

HYDRO 

45 

T I ME=T I ME+DTNH 

HYDRO 

46 
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SUBROUTINE  HYDRO  (Continued) 


I  SPALL  =  0 

HYDRO 

47 

FAC=FLOAT (MI N0(N-1 , 20) )/20. 

HYDRO 

48 

LL  =  0 

HYDRO 

49 

DO  900  J  =  J I N I T , JF I N 

HYDRO 

50 

c 

CHECK  FOR  THE  APPROPRIATE  PATH 

HYDRO 

51 

10 

XGLD=*X  (  J  )  $  UOLD=*U  (  J  ) 

HYDRO 

52 

IF  ( H ( J  j  2)  . EQ .  NORMAL)  GO  TO  100 

HYDRO 

53 

IF  ( H ( J  j  2 )  .EQ.  L INTER)  GO  TO  900 

HYDRO 

54 

IF  ( H ( J , 2 )  .EQ.  R1NTER)  GO  TO  200 

HYDRO 

55 

IF  ( H ( J , 2)  .EQ.  SPALL  )  GO  TO  300 

HYDRO 

56 

IF  ( H ( J , 2)  .EQ.  MIRROR)  GO  TO  500 

HYDRO 

57 

IF  ( H ( J , 2)  .EQ.  PRESS  )  GO  TO  600 

HYDRO 

58 

IF  ( H ( J , 2)  .EQ.  INF  )  GO  TO  700 

HYDRO 

59 

c 

HYDRO 

60 

c####*####  NORMAL  PATH  WITHIN  A  MATERIAL  ** 

HYDRO 

61 

C 

HYDRO 

62 

1  00 

IF  (NSPEC.GT.O  .OR.  ABSC U( J) -U ( J+1 ) ) . GT . 0 . 001  .OR.  EHL(J).GT.1. 

HYDRO 

63 

1  .OR.  ABS(RHLAST) . GT . 1 .  .OR.  NPR(M).EQ.I)  GO  TO  102 

HYDRO 

64 

101 

UH=U(J)  S  RH=RHL ( J )  $  XH= , 5* (X( J+1 ) +X( J) +DTNH*U( J ) ) 

HYDRO 

65 

DH=DHL ( J )  $  EH=EHL ( J ) 

HYDRO 

66 

X(J)=X(J)+DTNH*U(J)  $  GO  TO  800 

HYDRO 

67 

102 

CALL  HAFSTEP 

HYDRO 

68 

C 

VELOCITY  CALCULATION 

HYDRO 

69 

120 

IF  (NALPHA-2)  125,130,135 

HYDRO 

70 

C 

PLANAR  CASE 

HYDRO 

71 

125 

U ( J ) =UOLD -2 . *DTNH* ( RH-RHLAST ) / ( ZHL ( J- 1 )+ZHL( J) ) 

HYDRO 

72 

GO  TO  140 

HYDRO 

73 

C 

CYLINDRICAL  CASE 

HYDRO 

74 

1  30 

XBAR1 =SQRT ( (X( J-1 ) **2+X( J)**2)/2. ) 

HYDRO 

75 

XBAR2=SQRT ( ( X ( J ) **2+X (J+1 )**2)/2. ) 

HYDRO 

76 

U( J)=U( J)+4. *  DTNH* ( RHLAST  *XBAR1 -RH*XBAR2+ ( PHL ( J- 1  )+SDT( J-1  ) )* 

HYDRO 

77 

1  ( X ( J ) -XBAR1 ) + ( PHL ( J ) +SDT ( J ) ) * ( XBAR2-X ( J ) ) ) / ( ZHL ( J ) +ZHL ( J - 1 ) ) 

HYDRO 

78 

GO  TO  140 

HYDRO 

79 

C 

SPHERICAL  CASE 

HYDRO 

80 

135 

XBAR1  =  ( ( X  C J-1  ) *  *3+X ( J ) * *3 ) /2  .  )*#(1  ,/3.  ) 

HYDRO 

81 

XBAR2  =  ( (X( J)**3+X( J+1 ) **3)/2. ) **( 1 . /3. ) 

HYDRO 

82 

U( J)  =  UOLD-2. *DTNH* ( RH*XBAR2** 2 -RHLAST *XBAR1 *  *2+0 . 5* ( SHL (J-1  ) -3. * 

HYDRO 

83 

1  PHL (J-1 ) ) * (XBAR1+XC J) ) *(X( J) -XBAR1 ) +0 . 5* ( SHL ( J ) -3 . * PHL ( J ) ) 

HYDRO 

84 

1  * ( XBAR2+XC  J ) ) * ( XBAR2-X ( J ) )  )/(ZHL( J-1  ) +ZHL( J ) ) *3. 

HYDRO 

85 

C 

COORDINATE  CALCULATION 

HYDRO 

86 

140 

X( J)=X( J)+0.5*DTNH*(U( J)+UOLD) 

HYDRO 

87 

DT=(X( J+1 )+U( J+1 ) *DTNH-X( J) ) /CEF 

HYDRO 

88 

GO  TO  800 

HYDRO 

89 

C 

HYDRO 

90 

c*********  INTERFACE  ** 

HYDRO 

91 

C 

HYDRO 

92 

C 

LEFT  VALUES  ARE  IN  (J-1)  CELLS  AND  RIGHT  VALUES  ARE  IN  (J)  CELLS 

HYDRO 

93 

200 

IF  (X(J-1)  .LT.  X(J))  GO  TO  300 

HYDRO 

94 

MLAST  =  M  $  LL  =  LL+1  $  M  =  JMAT ( LL ) 

HYDRO 

95 

CALL  HAFSTEP 

HYDRO 

96 

C 

CHECK  STRESS  AND  SET  INDICATORS  FOR  SPALL 

HYDRO 

97 

J1 =J-1 

HYDRO 

98 

IF  ( R ( LL )  .GT.  T ( J 1 ) )  GO  TO  205 

HYDRO 

99 

H ( J, 2 ) =SPALL  $  R ( LL )=T(J1 )=0.  $  I SPALL= I SPALL+1 

HYDRO 

1  00 

IF  ( MAX PR ( 9 )  . LE.  0)  GO  TO  205 

HYDRO 

101 

PRINT  5230,  N , NN , LL, T I  ME 

HYDRO 

102 

205 

J1=J-1  $  J2= J-2 

HYDRO 

103 

ULOLD=U ( J 1 ) 

HYDRO 

104 

IF  (NALPHA-2)  210,212,215 

HYDRO 

1  05 

C 

PLANAR  CASE 

HYDRO 

1  06 

210 

U( J)=(U( J1 )*ZHL( J2)+U( J)*ZHL( J) -2. *DTNH*( RH-RHLAST) )/ 

HYDRO 

1  07 

1  ( ZHL ( J ) +ZHL ( J2 ) ) 

HYDRO 

1  08 

GO  TO  218 

HYDRO 

1  09 

C 

CYLINDRICAL  CASE 

HYDRO 

1  1  0 

212 

XBAR1 =SQRT( ( X ( J2 ) * *2+X ( J ) * * 2) /2 . ) 

HYDRO 

1  1  1 

XBAR2=SQRT ( ( X ( J ) * #2+X ( J+1 )**2)/2. ) 

HYDRO 

1  12 

U( J)  =  (U( J1  ) *ZHL (J2)+U(J)*ZHL(J)+4. *DTNH* ( RHLAST  *XBAR1 -RH*XBAR2+ 

HYDRO 

113 

1  ( PHL ( J2 ) +SDT ( J2) ) *(X( J) -XBAR1 ) + ( PHL ( J ) +SDT ( J ) ) * ( XBAR2-X ( J ) ) ) )/ 

HYDRO 

1  14 

2  ( ZHL ( J ) +ZHL ( J2 ) ) 

HYDRO 

1  15 

GO  TO  218 

HYDRO 

1  1  6 

C 

SPHERICAL  CASE 

HYDRO 

1  17 

215 

XBAR1  =  ( (X( J2)**3+X( J)**3)/2. )*»C1 ./3. ) 

HYDRO 

1  1  8 

XBAR2  =  ( (X( J)*#3+X( J+1 )**3)/2. )**(1 ./3. ) 

HYDRO 

1  1  9 

U(J)  =  (U(J1 ) *ZHL ( J2 ) /3 . +U ( J ) #ZHL ( J ) /3 . -2 . *DTNH 

HYDRO 

120 

1  * ( RH*XBAR2* * 2 -RHLAST  *XBAR1 **2+0 . 5* (SHL( J2) -3. *PHL( J2) )* 

HYDRO 

121 

265 


SUBROUTINE  HYDRO  (Continued) 


2  CXBAR1 +XC J) ) *(XC J) -XBAR1 ) +0 . 5* C SHL ( J ) -3  . *PHL( J) ) * (XBAR2+X( J) ) 

HYDRO 

1  22 

3  * ( XBAR2-X ( J ) ) ) ) / ( ZHL ( J ) +ZHL ( J2 ) )*3. 

HYDRO 

1  23 

21  8 

U( J1 )=U(J) 

HYDRO 

124 

X(J)*X(J1 ) *X( J ) + , 5*DTNH*(U(J) +UOLD ) 

HYDRO 

1  25 

R(LL) =(RH*ZHL( J2 ) +RHLAST*ZHL ( J ) +D . 5* ( ULOLD -UOLD ) *ZHL( J2)* 

HYDRO 

1  26 

1  ZHL ( J ) /DTNH ) / ( ZHL ( J ) +ZHL ( J2) ) 

HYDRO 

1  27 

DT= ( X ( J+1 )+U( J+1 ) *DTNH-X( J ) ) /CEF 

HYDRO 

1  28 

22D 

CONTINUE 

HYDRO 

1  29 

GO  TO  8DD 

HYDRO 

1  30 

C 

HYDRO 

131 

C*  *  *  * 

*****  INTERFACE  SPALL 

** 

HYDRO 

132 

C 

HYDRO 

133 

30D 

IF  (J  .EQ.  JINIT)  GO  TO  330 

HYDRO 

1  34 

MLAST-M 

HYDRO 

135 

C 

LEFT  SIDE 

HYDRO 

136 

J1 =  J-1 

HYDRO 

1  37 

XLOLD=X ( J - 1 )  $  ULOLD=U ( J - 1 ) 

HYDRO 

138 

IF  ( NALPHA-2 )  305,310,315 

HYDRO 

1  39 

C 

PLANAR  CASE 

HYDRO 

140 

305 

U( J-1 ) =UL0LD+2 . * DTNH* RHLAST/ ZHL (J-2) 

HYDRO 

141 

GO  TO  320 

HYDRO 

142 

C 

CYLINDRICAL  CASE 

HYDRO 

143 

310 

XBAR1 =SQRT( ( X ( J “2 ) * *2+X ( J -  1  )**2)/2.  ) 

HYDRO 

144 

U  (  J  -  1 ) *  U ( J - 1  ) +4 . *DTNH*(RHLAST*XBAR1+(PHL(J-2)+SDT( J-2) )* 

HYDRO 

145 

1  (X( J-1 ) -XBAR1 ) )/(ZHL( J-2) ) 

HYDRO 

146 

GO  TO  320 

HYDRO 

147 

C 

SPHERICAL  CASE 

HYDRO 

148 

315 

XBAR1  =  ( (X( J-2)**3+X( J-1 )**3)/2, )**(1 ,/3. ) 

HYDRO 

149 

U( J-1 )  =  ULOLD+2 . *DTNH* ( RHLAST*XBAR1 * * 2-D . 5* ( SHL ( J -2) -3. *PHL( J-2) 

HYDRO 

1  50 

1  ) * ( XBAR1 +X(J-1))*(X(J-1) -XBAR1 ) ) /ZHL ( J -2) *3 . 

HYDRO 

151 

320 

X( J-1 ) “XLOLD+O , 5* DTNH* ( U ( J - 1 )+ULOLD) 

HYDRO 

1  52 

DT  c  1  . 

HYDRO 

1  53 

IF  (J  .EQ.  JFIN)  GO  TO  9DD 

HYDRO 

1  54 

C 

RIGHT  SIDE 

HYDRO 

1  55 

330 

LL  =  LL  +  1  $  M  =  JMAT ( LL ) 

HYDRO 

1  56 

R ( LL ) *0 . 

HYDRO 

157 

IF  (NSPEC.GT.O  .OR.  ABS( U( J ) -U( J+1 ) ) . GT . 0 . 001  .OR.  EHL(J) 

.GT. 1 . 

HYDRO 

1  58 

1  .OR.  ABS(RHLAST) . GT . 1 .  .OR.  NPR(M).EQ.I)  GO  TO  332 

HYDRO 

1  59 

331 

UHCU ( J )  $  RH=RHL ( J )  S  XH= . 5* ( X ( J+1 ) +X( J ) +DTNH*U ( J ) ) 

HYDRO 

160 

X( J ) *x ( J ) +DTNH*U( J )  $  DT  *  1  . 

HYDRO 

1  61 

IF  (NALPHA  .GT.  1  .AND.  J  . EQ .  JINIT)  X  (  J  )  s AMAX 1 ( XOLD , D .  ) 

HYDRO 

1  62 

IF  (NALPHA  .GT.  1  .AND.  J  . EQ .  JINIT  .AND.  X(J)  .EQ.  D.) 

U( J)“D. 

HYDRO 

1  63 

DHbDHL(J)  $  EH® EHL ( J ) 

HYDRO 

1  64 

IF  (J  .EQ.  JINIT)  SOD, 335 

HYDRO 

1  65 

332 

CALL  HAFSTEP 

HYDRO 

166 

IF  (RHLCJ)  .GT.  T ( J ) )  GO  TO  334 

HYDRO 

1  67 

RH=RHL( J)=SHL( J)»PHL( J) =T( J) =0. 

HYDRO 

1  68 

334 

UOLD=U ( J )  $  XOLD*X ( J ) 

HYDRO 

1  69 

IF  (NALPHA  -  2)  3341,3342,3343 

HYDRO 

170 

C 

PLANAR  CASE 

HYDRO 

1  71 

3341 

U ( J ) ■ UOLD-2 . *DTNH*RH/ZHL ( J ) 

HYDRO 

1  72 

GO  TO  3344 

HYDRO 

173 

C 

CYLINDRICAL  CASE 

HYDRO 

1  74 

3342 

XBAR2*SQRT ( ( X ( J ) * *2+X ( J+1 )**2)/2. ) 

HYDRO 

175 

U( J)=U0LD+4. *DTNH* ( -RH*XBAR2+( PHL ( J ) +SDT ( J ) ) * ( XBAR2-X ( J ) ) ) /ZHL ( J ) 

HYDRO 

1  76 

GO  TO  3344 

HYDRO 

177 

C 

SPHERICAL  CASE 

HYDRO 

1  78 

3343 

XBAR2  «  ( (X( J)**3+X( J+1 )**3)/2. )**(1 ./3. ) 

HYDRO 

179 

U( J)  ■  UOLD-2. *DTNH*(RH*XBAR2**2+0.5*(SHL( J)-3.*PHL( J) )* 

HYDRO 

1  80 

1  ( XBAR2+X ( J ) ) * ( XBAR2-X ( J ) ) )/ZHL( J)*3. 

HYDRO 

1  81 

3344 

X( J ) =XOLD+D . 5*DTNH* ( U ( J ) +UOLD ) 

HYDRO 

1  82 

IF  (NALPHA  .GT.  1  .AND.  J  . EQ .  JINIT)  X ( J ) = AMAX1 ( XOLD , 0 . ) 

HYDRO 

1  83 

IF  (NALPHA  .GT.  1  .AND.  J  . EQ .  JINIT  .AND.  X(J)  . EQ .  D.) 

U( J)=0. 

HYDRO 

1  84 

DT«(X( J+1 )+U( J+1 ) *DTNH-X ( J ) ) /CEF 

HYDRO 

185 

C 

CHECK  FOR  RECOMBINATION 

HYDRO 

1  86 

IF  ( J  . EQ.  JINIT)  GO  TO  8DD 

HYDRO 

1  87 

335 

IF  (X(J)  .LE.  X(J-1))  GO  TO  365 

HYDRO 

1  88 

I  SPALL* I SPALL  +  1  $  GO  TO  8D0 

HYDRO 

189 

C 

RESET  ARRAY  VARIABLES  AND  GO  TO  INTERFACE  ROUTE 

HYDRO 

1  90 

365 

H ( J , 2 ) “R I NTER  $  X(J)=XOLD  $  X(J-1)«XL0LD  $  U(J)=UOLD 

HYDRO 

191 

PRINT  1 365 , N , J , T I  ME 

HYDRO 

1  92 

U( J-1 ) “ULOLD 

HYDRO 

193 

DT  =  D . 1  * AM I N 1  (DT, DTP) 

HYDRO 

1  94 

IF  (DT  .LT.  0. )  DT “ 1 . 

HYDRO 

1  95 

IF  (DT  .GT.  DTMIN)  GO  TO  205 

HYDRO 

1  96 

266 


SUBROUTINE  HYDRO  (Continued) 


DTMI N=DT  S  JTSaJ  $  GO  TO  205 

HYDRO 

197 

c 

HYDRO 

1  98 

C*  ********  MIRROR  AT  FRONT  SURFACE 

HYDRO 

1  99 

C 

HYDRO 

200 

500 

LL=LL+ 1  S  M= JMAT ( LL ) 

HYDRO 

201 

IF  (J  .GE.  JFIN-1)  GO  TO  800 

HYDRO 

202 

CALL  HAFSTEP 

HYDRO 

203 

R ( LL ) =RHL ( J ) 

HYDRO 

204 

X ( J ) =X ( J ) +DTNH*U ( J ) 

HYDRO 

205 

DT=(X( J+1 )+DTNH*U( J+1 ) -X( J) )/CEF 

HYDRO 

206 

IF  ( R ( LL )  .GT.  T(JFIN-I))  GO  TO  800 

HYDRO 

207 

H( J, 2) =SPALL 

HYDRO 

208 

R(LL)=T( JFIN-1 )=0. 

HYDRO 

209 

GO  TO  800 

HYDRO 

210 

C 

HYDRO 

21  1 

C*********  PRESSURE  BOUNDARY  AT  FRONT  SURFACE  ** 

HYDRO 

212 

C 

HYDRO 

213 

600  LL=LL+ 1 

HYDRO 

214 

IF  (J  .EQ.  JFIN)  GO  TO  650 

HYDRO 

215 

M=JMAT(LL) 

HYDRO 

216 

IFCT6C1)  .EQ.  0.)  GO  TO  602 

HYDRO 

21  7 

R ( LL ) =P6 ( 1 ) *EXP( ( T I ME-DTNH ) /T6(  1  ) ) 

HYDRO 

21  8 

CALL  HAFSTEP 

HYDRO 

219 

RHAF  =  P6 ( 1  )*EXP((TIME-0.5*DTNH)/T6(1  ) ) 

HYDRO 

220 

GO  TO  603 

HYDRO 

221 

602 

R ( LL ) =S I GMAT ( 1 , T I ME-DTNH) 

HYDRO 

222 

CALL  HAFSTEP 

HYDRO 

223 

RHAF=S I GMAT ( 1 , T I ME-0 . 5*DTNH ) 

HYDRO 

224 

603 

CONTINUE 

HYDRO 

225 

IF  ( NALPHA-2 )  605,610,615 

HYDRO 

226 

C 

PLANAR  CASE 

HYDRO 

227 

605 

U  C  J ) =  UOLD -2 . * ( RH-RHAF) /ZHL ( J ) *DTNH 

HYDRO 

228 

GO  TO  620 

HYDRO 

229 

C 

CYLINDRICAL  CASE 

HYDRO 

230 

610 

XBAR2=SQRT( C X ( J ) **2+X( J+1 )**2)/2. ) 

HYDRO 

231 

UC J) =U( J) +4 . *DTNH* ( RHAF*X ( J ) -RH*XBAR2+ ( PHL ( J ) +SDT ( J ) ) * ( XBAR2-X ( J ) ) 

HYDRO 

232 

1  )/ZHL(J) 

HYDRO 

233 

GO  TO  620 

HYDRO 

234 

C 

SPHERICAL  CASE 

HYDRO 

235 

615 

XBAR2=  C ( X  C J) **3+X( J+1 ) **3) /2  .  ) ** ( 1  . /3  .  ) 

HYDRO 

236 

U( J) =U( J)+2. *DTNH* ( RHAF*XC  J ) **2-RH*XBAR2**2  +  0 . 5* ( SHLC  J ) -3. *PHL ( J ) ) 

HYDRO 

237 

1  * ( XBAR2+X C  J ) ) * ( XBAR2-X C  J ) ) )/ZHL( J)*3. 

HYDRO 

238 

620 

X(J)=X(J)+0. 5*DTNH* ( UC  J ) +UOLD) 

HYDRO 

239 

DT=(X( J+1 )+DTNH*UC J+1 ) -XC J) ) /CEF 

HYDRO 

24  0 

GO  TO  800 

HYDRO 

241 

C 

HYDRO 

24  2 

C*  *  *  * 

*****  PRESSURE  BOUNDARY  AT  OUTER  SURFACE 

HYDRO 

243 

c 

HYDRO 

244 

650 

IF  CT6C2)  .EQ.  0.)  GO  TO  652 

HYDRO 

245 

RCLL) =P6C2) *EXP( ( T I ME-DTNH) /T6 C 2 ) ) 

HYDRO 

246 

RHAF=P6 ( 2 ) *EXP ( (TIME-0. 5*DTNH)/T6C2) ) 

HYDRO 

24  7 

GO  TO  654 

HYDRO 

248 

652 

RCLL) =SIGMAT(2, T I ME-DTNH) 

HYDRO 

249 

RHAF=SIGMAT(2, TIME-0. 5*DTNH) 

HYDRO 

250 

654 

CONTINUE 

HYDRO 

251 

UOLD=U ( J - 1 ) 

HYDRO 

252 

IF  (NALPHA-2)  660,665,670 

HYDRO 

253 

C 

PLANAR  CASE 

HYDRO 

254 

660 

U ( J- 1  ) =U0LD+2 . * ( RHLAST-RHAF) /ZHL  C  J-2 ) *DTNH 

HYDRO 

255 

GO  TO  675 

HYDRO 

256 

C 

CYLINDRICAL  CASE 

HYDRO 

257 

665 

XBAR1 =SQRT ( (XC J-2) **2+X( J-1 )**2)/2. ) 

HYDRO 

258 

UC  J-1 ) =U ( J- 1 ) +4 . *DTNH* ( RHLAST *XBAR1 -RHAF*X( J-1 )  +  ( PHL ( J -2 ) +SDT ( J -2 ) 

HYDRO 

259 

1  ) * (XC J-1 ) -XBAR1 ) ) /ZHL (J-2) 

HYDRO 

260 

GO  TO  675 

HYDRO 

261 

C 

SPHERICAL  CASE 

HYDRO 

262 

670 

XBAR1 = ( (XC J-2) **3+X( J-1 ) * *3 ) /2 . ) * * ( 1 . /3 . ) 

HYDRO 

263 

UC  J- 1 ) =U( J - 1 ) +2 . *DTNH* ( RHLAST *XBAR1 * *2-RHAF*X( J - 1 ) * *2  +  0 . 5* ( SHL ( J -2 

HYDRO 

264 

1 ) -3. *PHL( J-2) ) *(XBAR1+XC J-1 ) )*CXBAR1 -XC J-1 ) ) ) /ZHL ( J -2 ) *3 . 

HYDRO 

265 

675 

X(J)=X( J-1 )=X(J-1 )+0. 5*DTNH*(U( J-1 )+UOLD) 

HYDRO 

266 

UC  J ) =U( J-1  )  $  DT=(X( J-1 ) +U (J-1 ) *DTNH-X( J -2 ) )/CHL( J-2) 

HYDRO 

267 

GO  TO  800 

HYDRO 

268 

C 

HYDRO 

269 

C*********  INFINITE  BOUNDARY  AT  FRONT  SURFACE. 

HYDRO 

270 

C 

HYDRO 

271 

267 


SUBROUTINE  HYDRO  (Concluded) 


700 

IF  (J  .EQ.  JFIN)  GO  TO  720 

HYDRO 

272 

LL=LL+1  $  Mc JMAT ( LL ) 

HYDRO 

273 

IF  (ABS(U( J) -U( J+1 ) )  .LT  .001  .AND.  EHL(J)  . LT .  1.  .AND. 

HYDRO 

274 

1  NPR(M)  . NE.  1 )  GO  TO  101 

HYDRO 

275 

DS=SQRT(RHOS(M) * (EQSTC(M) +1  . 333*MU(M) ) ) *  <U( JFI N+1  ) -UOLD) 

HYDRO 

276 

DP=EQSTC(M ) / ( EQSTC (M) +1 . 333*MU(M) ) *DS 

HYDRO 

277 

SDH=SHL( JFIN+1 )-PHL(JFIN+1 J+DS-DP 

HYDRO 

278 

PHL( JFI N+1 ) =PHL( JFI N+1 ) +DP 

HYDRO 

279 

U( JFIN+1 )=UOLD 

HYDRO 

280 

IF  (ABS(SDH)  .GT.  0.6667*  YHL ( J ) )  SDH  =  S I GN ( 0 . 6667* YHL ( J )  ,  SDH ) 

HYDRO 

281 

SHLCJFIN+1 ) =RHLAST  =SDH+PHL (JFI N+1  ) 

HYDRO 

282 

R ( LL) *RHLAST 

HYDRO 

283 

GO  TO  100 

HYDRO 

284 

C 

HYDRO 

285 

C*********  INFINITE  BOUNDARY  AT  REAR  SURFACE. 

HYDRO 

286 

C 

HYDRO 

287 

720 

LL=LL+1 

HYDRO 

288 

DS=SQRT ( RHOS(M) * ( EQSTC(M) +1 ,333*MU(M) ) )*(U(J-1  )-U(J) ) 

HYDRO 

289 

DP = EQSTC (M) / ( EQSTCfM ) +1 . 333*MU(M) ) *DS 

HYDRO 

290 

SDH=SHL( J- 1 ) -PHL( J- 1 1+DS-DP 

HYDRO 

291 

PHL( J-1 ) =PHL( J-1 ) +DP 

HYDRO 

292 

UOLD=U( J) =U( J-1 ) 

HYDRO 

293 

IF  (ABS(SDH)  .GT.  0.6667*  YHL( J- 1 ) )SDH=SI GN(0 . 6667 * YHL ( J-1  ) , SDH) 

HYDRO 

294 

SHL( J-1 ) =RH=RHL( J-1 ) =SDH+PHL( J-1 ) 

HYDRO 

295 

R ( LL) =RH 

HYDRO 

296 

U( J-1 ) =UOLD-DTNH* ( RH-RHLAST) /ZHL( J-2) 

HYDRO 

297 

X<  J-1 )=X( J-1 )+0.5*DTNH*( UOLD+U (J-1 ) ) 

HYDRO 

298 

C 

HYDRO 

299 

c#*##***#*  END  OF  HYDRO  PATHS 

HYDRO 

300 

C 

HYDRO 

301 

C 

HYDRO 

302 

800 

CONTINUE 

HYDRO 

303 

IF  ( LSUB ( 7 )  .EQ.  1)  RETURN 

HYDRO 

304 

C###***  END  OF  CYCLE  RESET 

HYDRO 

305 

XLAST “XOLD  $  ULAST=UOLD 

HYDRO 

306 

XHLAST  =  XH  $  UHLAST  =  UH  $  RHLAST  *RH  $  DHLAST  =  DH 

HYDRO 

307 

EHLAST=EH  $  SHLAST=SH 

HYDRO 

308 

C 

HYDRO 

309 

C 

SMAX  CALCULATION 

HYDRO 

31  0 

IF  (SHL(J)  .GT.  SMAX)  820,822 

HYDRO 

31  1 

820 

SMAX=SHL(J)  $  JSMAX= J 

HYDRO 

312 

C 

HYDRO 

313 

C 

TIME  STEP  CALCULATION 

HYDRO 

314 

822 

IF  (DT  .LT.  0.  )  DT  = 1  . 

HYDRO 

315 

IF  (DT  .GT.  DTMIN)  GO  TO  826 

HYDRO 

316 

824 

DTM I N=DT  $  JTSsJ 

HYDRO 

31  7 

826 

DTP=DT 

HYDRO 

318 

C 

HYDRO 

31  9 

C 

JSTAR  CALCULATION 

HYDRO 

320 

850 

IF  ( ABS ( U ( J ) )  .LT.  1.E-3  .AND.  EHL(J)  . LT .  1.)  851,900 

HYDRO 

321 

851 

IF  (J  .GT.  JSTAR)  852,900 

HYDRO 

322 

852 

JSTAR= J - 1 

HYDRO 

323 

GO  TO  990 

HYDRO 

324 

C 

END  OF  HYDRO  INNER  LOOP 

HYDRO 

325 

900 

CONTINUE 

HYDRO 

326 

JSTAR= JFI N“ 1 

HYDRO 

327 

990 

DTN=DTNH 

HYDRO 

328 

JTS  =  JTS+1 000* I  SPALL 

HYDRO 

329 

C 

END  OF  HYDRO  OUTER  LOOP 

HYDRO 

330 

1000 

CONTINUE 

HYDRO 

331 

1002 

RETURN 

HYDRO 

332 

1365  FORMAT (*  RECOMBINATION  AT  CYCLE  *14,*,  J=*I4,*,  T 1 ME= 

*  1  PE  10.3) 

HYDRO 

333 

51  15 

FORMAT  (*  SPALL  AT  N,  NN=*2I4,*  FOR  J=*I4,*,  NSPALL=* 14, *,  T 1 ME=* 

HYDRO 

334 

1  1PE10.3) 

HYDRO 

335 

5230 

FORMAT  (*  INTERFACE  SPALL  AT  N,  NN  =*214,*  ON  LEFT  OF 

LAYER  *12, 

HYDRO 

336 

1  *,  T I ME=  *  1  PEI  0.3) 

HYDRO 

337 

END 

HYDRO 

338 
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200 

C 

c 

220 

300 

C 


SUBROUTINE  HYPO 

SUBROUTINE  HYPO ( 1  NOE , 1 N , M , C J » OH , EMU ♦ EMUD * EPS f EPSO * J , P * S0H ) 

THIRD  VERSION  OF  VARIABLE  MODULUS  MODEL  INCLUDING  AN  INTEGRAL 
DEFINITION  OF  LOADING  SURFACES  FOR  P  AND  SDH  AND  DIFFERENTIAL 
RELATIONS  ONLY  FDR  UNLOADING 

ROUTINE  IS  WRITTEN  FOR  I -D I MENSI ONAL  PLANAR  AND  SPHERICAL  FLOw. 
FOR  1 -D  CYLINDRICAL  FLOW  *  SDH  IS  INTERPRETED  AS  2/3XEFFFCT I VE 
STRESS  AND  RADIAL  AND  TANGENTIAL  DEVIATOR  STRESSES  ARE  COMPUTED 
FROM  SDH  IN  HSTRESS • 

SUBROUTINE  COMPUTES  PRESSURE  P  AND  DEVIATOR  STRESS  SDH  AND 
SOUND  SPEED  CJ. 

SUBROUTINE  IS  CALLED  TWICE 
I N D E  =  0  CALLED  FROM  GENRAT 

READ  MATERIAL  PROPERTY  DATA  AND  INITIALIZE  VARIABLES 
I NDE= 1  CALLED  FROM  HSTRESS 

COMPUTE  PRESSURE,  DE V 1 A  TOR  STRESS  *  AND  SOUND  SPEED. 

REAL  KOf K1 ,K2,K0UN,K1UN,K2UN,KY 


HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 


G 1 (M)=l .333*G1 (M) 

G2(M)=0.667*G2(M) 

GU (M) =1 , 333#GU ( M ) 

K2(M)=0.5»K2(M) 

KiUN(M)=0.5*KlUN(M) 

K2UN(M)=0.5*K2UN(M) 

RETURN 

#**C0MPUTATIDN  OF  STRESS#** 

DMU=EMU-EMUO 
DEPS=EPS-EPSD 
DEVIATDR  STRESS 

SDH  =  AM1N1  (SDH  +  GU (M) #DEPSf EPS# (GO (M)  ♦G 1  (M) #EMU*G2 ( M ) *EPS ) ) 

PRESSURE 

IF (EMU.LT.EMUY(M) )GD  TO  220 

BULK  =K0  UN ( M ) +K1UN ( M ) # (EMU+EMUO) +K2UN (M) » (EPS ♦EPSO) 

P  =  AM  I N 1  (P*DMU*BULK ,KY (M) #EMUY (M) +  EMU*  <K0 (M)+Kl(M)*EMu*K2(M)#Eps)) 
GO  TO  300 

P  =  AM  INI  (P*DMU#Ky  (M)  ,Ky(M)«EMU) 

BULK=KY (M) 

EMUO=EMU 
EPSO=EPS 
SDUND  SPEED 

C J=SQ  RT ( (RULK*GU(M) )/DH) 


2 

3 

4 

5 

6 

7 

8 
9 

10 
1  1 
1  2 

13 

14 

15 

16 

17 

18 

19 

20 
21 


DIMENSION  GO (6) 

»G1 (6) .62(6) 

.  GU 

(6) 

,K0 (6) 

1 *K1 (6) 

.K2  (6) .KOUN (6) . 

HYPO 

22 

K1UN (6) ,K2UN (6) 

,KY  (6)  ,EMUy ( 

6) 

HYPO 

23 

IF<1NDE.GT.O)GO 

TO  200 

HYPO 

24 

HYPO 

2b 

*»*READ  AND  INI 

T1AL1ZE<**« 

HYPO 

26 

HYPO 

27 

READI1N.1000) A1 

.GO (M) .61 ( 

M) 

.62 

(M) 

,GU (M) 

i fKY (M) 

,  EMUY (M) 

HYPO 

28 

WRITE(6*1000)A1 

,G0  !M>  *Gl < 

M) 

*G2  i 

(M) 

,GU (M) 

i fKY (M) 

, EMUY ( M ) 

HYPO 

29 

READ ( IN, 1000) A1 

*  K  0  <  M )  .  K 1  ( 

M) 

»K  2 

(M) 

, K  OUN i 

! M )  , K 1  UN  <  M ) .K2UN i 

( M ) 

HYPO 

30 

I*R1TE(6.1000)  A1 

»  KQ  (  M )  »  K 1  < 

M) 

»K2 

(M) 

, K  0  UN i 

(M) .KlUN (M) ,K2UN i 

( M ) 

HYPO 

31 

RETURN 

1  000  FDRMAT ( A1 0  *  1 P7E  1  0 # 3) 
END 


HYPO 

hypo 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 

HYPO 


32 

33 

34 

35 

36 

37 

38 

39 
A  0 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 
b  1 
b2 
bj 
b4 

55 

56 
b  7 

58 

59 

60 
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SUBROUTINE  PEST 


SUBROUTINE  PEST( LS,  I N,  NPRM, H, J, TJ, DT, M, C, D, DOLD, RHOS, RHOI , P, PST1 ,  PEST 

1  ASTI , E, EOLD, F , EQSTCM, EQSTDM, EQSTSM, EQSTQM, MUM, YADDM, RW, ENT, CZJ,  PEST 

2  CWJ, EQSTHM, EQSTEM, EQSTNM, EQSTVM, EQSTAM, DPDDJ, DPDEJ, NCYC)  PEST 

c  PEST 

C  PEST  2,  VERSION  OF  DEC  1976  PEST 

C  WRITTEN  AT  STANFORD  RESEARCH  INSTITUTE  BY  L.  SEAMAN  AND  R.E.  TOKHEIM  PEST 
C  CODE  PROVIDES  EQUATIONS  OF  STATE  FOR  POROUS  AND  SOLID  MATERIALS  PEST 

C  UNDER  COMPRESS  I ON(C),  TENSION! T)  AND  RECOMPRESS  I  ON ( R)  BY  RATE-  PEST 

C  INDEPENDENT  AND  RATE-DEPENDENT  MODELS.  INITIALIZATION  FOR  ALL  MODELS  PEST 

C  IS  INCLUDED.  PEST 

c  PEST 

C  INDICATORS  OF  MODELS  TO  BE  CHOSEN  FOR  STATIC(S)  AND  DYNAMIC(D)  PEST 

C  CONDITIONS  FOLLOW:  PEST 

C  KCS  OR  KRS :  RATE- I NDEPENDENT  COMPRESSION  PEST 

C  1  POREQST  PEST 

C  2  PORHOLT  PEST 

C  3  CARROLL-HOLT  PEST 

C  4  HERRMANN  P-ALPHA  PEST 

C  5  HENDRON  PEST 

C  KTS :  RATE- I  NDEPENDENT  TENSION  PEST 

C  1  VARIABLE  STRENGTH  PEST 

C  2  FRACTURE  MECHANICS  PEST 

C  3  CARROLL-HOLT  PEST 

c  PEST 

C  KCD  OR  KRD :  COMPRESSION  WITH  RATE  EFFECTS  PEST 

C  1  NO  RATE  DEPENDENCE  PEST 

C  2  LINEAR  VISCOUS  VOID  COMPRESSION  PEST 

C  3  PORHOLT  PEST 

C  4  BUTCHER  P-ALPHA-TAU  PEST 

c  PEST 

C  KTD :  TENSION  WITH  RATE  EFFECTS  PEST 

C  1  NO  RATE  DEPENDENCE  PEST 

C  2  N.A.G.  DUCTILE  FRACTURE  PEST 

C  3  BRITTLE  FRACTURE  AND  FRAGMENTATION  PEST 

c  PEST 

C  INDI CATORS(X)  ARE  READ  IN  THREE-DIGIT  PAIRS  FOR  S  AND  D  CONDITIONS:  PEST 

C  KCS, KTS, KRS=  OXOXOX  KCD, KTD, KRD=  OXOXOX  PEST 

c  PEST 

C  INDICATORS  H  AND  IH  PEST 

C  S  SOL  I D  PEST 

C  P  POROUS-PRESSURE  PEST 

C  T  POROUS-TENSION  PEST 

C  Q  POROUS -RECOMPRESS  I  ON  PEST 

C  Z  FRAGMENTATION  PEST 

C  R  RECOMPRESSION  AFTER  FRAGMENTATION  PEST 

c  PEST 

INTEGER  H, OUT  PEST 

REAL  MUM, MUP, K 1 C  PEST 

DIMENSION  KCS (4) ,KCD(4) ,KTS(4) , KTD (4 ) , KRS (4 ) ,  KRD (4 )  PEST 

DIMENSION  NPM ( 6) , NREG( 4 )  PEST 

DIMENSION  TPH ( 4 , 3 ) , DADP (4,3),K1C(4), TEMP ( 8 )  PEST 

DIMENSION  AK  ( 4 )  ,  MUP  (4),YADDP(4,5,3),  TERM ,  8,3)  PEST 

DIMENSION  RHOP (4,6,3), COSQ (4, 5, 3), Cl (4,5,3)  PEST 

DIMENSION  PORA (4,5,3), PORB (4 , 5,3), PORC(4 , 5,3)  PEST 

DIMENSION  EPS (4,3), DEL(4 , 3) , ALE(4 , 3) , APC( 4,3)  PEST 

DATA  SMF/1 .88/,EP/1 .E-6/, IDD/1H  /, OUT/6/, JQ1 /7H  -PEST-/,JQ2/  PEST 

1  1  OH  -POREQST-/, JQ3/1 OH  -CARROLL-/, JQ4/5HH0LT-/ ,  JQ5/1 OH  -HERRMANN  PEST 

2  / , JQ6/9H  P-ALPHA-/, JQ7/1 OH  -VARIA  ST/, JQ8/7HRENGTH-/  PEST 

3  , JQ9/1 OH  -FRACTURE/, JQ10/6H  MECH-/, JQ1 1 /I  OH  -LINEAR  V/,JQ12/  PEST 

4  9HISC  VOID-/, JQ13/10H  -DYNAMIC  /, JQ14/8HP0RH0LT-/, JQ1 5/  PEST 

5  1  OH  -PORHOLT-/, JQ1 6/8HBUTCHER-/ , JQS/5HSTAT : / , JQR/5HRATE : /  PEST 

6  , JQ1 7/1  OH  -DUCTILE  /, JQ1 8/9HFRACTURE-/  PEST 

C  PEST 

***  ZEROING  OF  ARRAYS  ***  c  PEST 

C  PEST 

IF  CLS-1)  1j8j1000  PEST 

1  DO  5  I  =  1,6  PEST 

5  NPM ( I )  =  0  PEST 

DO  50  I  a  1 , 4  PEST 

AK ( I )=MUPCI )=K1CCI )=0,  PEST 

50  NREGCI)  =0  PEST- 

DO  51  I  =  1,12  PEST 

51  TPH ( I  )  =  DADP ( I  )  =  EPS ( I  )  =  DEL ( I  )  =  ALEC  I)  =  APCCI)  =  0.  PEST 

DO  52  I  =  1 , 60  PEST 

52  YADDPCI ) =C0SQ ( I )*C1 Cl )=PCRACI )=PGRBCI )=PORCCI )=0.  PEST 


2 

3 

4 

5 

6 

7 

8 

S 

10 

1 1 

12 

1  3 

14 

1  5 

1  6 

17 

18 

1  9 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 

61 

62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 
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SUBROUTINE  PEST  (Continued) 


53 

54 

8 

C 

C  *  * 
C 

c  *  * 
c 

c  *  *  * 


c 


c  * 
c  * 


c  * 
1  0 
1  5 

20 


C 

c  *  *  * 
c 

490 

C 

c  *  * 


498 

501 


502 


503 


504 


DO  53  1=1, 72 
RHOP ( I ) =0. 

DO  54  1=1,96 
TER ( I  )  =  0 , 

MP  =  0  $  DPDD J  =  DPDEJ  =  0 .  $  LS= 1  $  CJ=1. 

MP=MP+ 1 
NPM(M)  =  MP 

******************  ******************** 

READI NG  OF  INPUT  DATA 

******************  ******************** 

READ  DATA  USED  BY  ALL  MODELS.  *** 

READ ( IN, 935 )A1 , KCS (MP) , KTS ( MP ) , KRS (MP) , A2,KCD(MP) , KTD(MP) 

1  , KRD ( MP ) 

WRITE ( 6, 935) A1 , KCS(MP) , KTS(MP) , KRS(MP) , A2, KCD(MP) , KTD(MP) 

1  jKRD(MP) 

WRI TEC  6, 960) I DD,  IN, JQ1 

READ ( I N, 91 9)A1  ,  AK(MP) , A2,MUP(MP)  ,  A3, YZERO,  A4 ,  RHOP ( MP ,  6,1) 

WRI TEC  6, 920 )A1 , AK ( MP ) , A2, MUP ( MP ) , A3, YZERO , A4 , RHOP ( MP, 6,1) 

WR I TE ( 6, 960 ) IDD, IN, JQ1 
ALFO  =  RHOS/RHOP ( MP , 6,  1  ) 

IFCAKCMP)  .GT.  0.  .AND.  AK(MP)  . LE .  EQSTCM* RHOP ( MP , 6, 1 ) 

1  /RHOS)  GO  TO  20 
IF  (AKCMP)  .GT.  0.)  GO  TO  10 

IF  AK  IS  NEGATIVE,  IT  IS  INTERPRETED  AS  THE  SHEAR  MODULUS  * 
OF  THE  SOLID.  * 

GS  =  -AKCMP) 

AKCMP)  =  EQSTCM/C ALFO+O. 75*EQSTCM/GS* C ALFO-1 . ) ) 

MUP CMP)  =  GS# ( 1  . -5. # ( 1 . -1 . /ALF0) * C  3 . *EQSTCM+4 . *GS)/ C  9. * EQSTCM 
1  +8 . *GS ) ) 

GO  TO  15 

IF  AK  IS  TOO  LARGE,  IT  IS  REDUCED  TO  THE  MAXIMUM  PERMITTED.  * 
AK  CMP) = EQSTCM# RHOP  CMP, 6,  1  )/RHOS 
WR I TE  C  6, 950 )  AKCMP),  MUPCMP) 

WRI TEC  6, 960) IDD, OUT,  JQ1 

YADDM  =  0 . 666667# YZERO  $  MUPCMP)  =  1 . 333333 *M UP  C  MP ) 

C  =  SQRT C  C AKCMP )+AMAX1  CO. , MUP CMP) ) )/AMl N1  CD, RHOP CMP, 6,  1  ) ) ) 

J2  =  5HC0MP,  $  J3  =  J4= 1 H 
N=  1 

KCSM  =  KCS C  MP )  $  KCDM  =  KCD  C  MP )  $  KTSM  =  KTSCMP )  S  KTDM  =  KTD  C MP ) 
KRSM  =  KRS C  MP )  $  KRDM  =  KRD  C  MP ) 

IF  CKTSM  .EQ.  0)  J3=5HTENS,  $  IF  CKRSM  . EQ .  0)  J4=5HREC0M 

READ  FOR  RATE- I NDEPENDENT  COMPRESSIVE  MODEL.  *** 

GO  TO  C490, 51 0, 520, 530, 540, 550)KCSM 
CONTINUE 

READ  AND  INITIALIZE  FOR  POREQST .  ** 

READ  C I N , 939 ) A 1 , NREG  C  MP ) 

WRI TEC  6, 940 )A1 , NREG CMP) 

WRI TEC  6, 960) I DD,  IN, JQ2,  IDD, JQS, J2, J3, J4 
READ  C I N, 909 )A1 ,  C RHOP CMP,  I , N) ,  I =1 , 5) 

WRI TEC  6, 91 0)A1  ,  C RHOP CMP,  I  , N) ,  I =1 , 5) 

WRI TEC  6, 960) I DD,  I N, JQ2 

DO  498  1=1,5 

COSQCMP, I , N)  =  4.0 

Cl  CMP,  I  , N )  =  0.15 

READ  C I N, 905) CTEMPC I  ) ,  I =1 , 8) 

DECODE  C3, 915, TEMP)  A1,A2 

IF  C  A 1  .EQ.  1 HC  .AND.  CA2  . EQ .  1  HO  .OR.  A2  . EQ .  1H0))  GO  TO  502 
IF  C  A 1  .EQ.  1 HC  .AND.  A2  . EQ .  1H1)  GO  TO  503 
GO  TO  504 

DECODE  C 80, 91 0, TEMP) A1 , C COSQCMP, I , N) , I =1 , 5) 

WRI TEC  6, 91 0)A1 ,  C COSQCMP,  I, N),  1=1,5) 

WRI TEC  6, 960) I DD,  I N, JQ2 
GO  TO  501 

DECODE  C 80, 91 0, TEMP ) A 1 , C Cl C MP , I , N ) , I = 1 , 5 ) 

WRI TEC  6, 91 0)A1 ,  C  Cl  CMP,  I , N) ,  I  =  1 , 5) 

WRI TEC  6, 960) IDD,  IN, JQ2 
GO  TO  501 

CZJ  =  COSQCMP, 5, 1 ) 

CWJ  =  Cl  CMP, 5,  1  ) 


PEST 

77 

PEST 

78 

PEST 

79 

PEST 

80 

PEST 

81 

PEST 

82 

PEST 

83 

c 

PEST 

84 

c 

PEST 

85 

c 

PEST 

86 

c 

PEST 

87 

c 

PEST 

88 

c 

PEST 

89 

PEST 

90 

PEST 

91 

PEST 

92 

PEST 

93 

PEST 

94 

c 

PEST 

95 

PEST 

96 

PEST 

97 

PEST 

98 

PEST 

99 

PEST 

100 

PEST 

101 

PEST 

1  02 

c 

PEST 

1  03 

c 

PEST 

1  04 

PEST 

1  05 

PEST 

1  06 

PEST 

1  07 

PEST 

1  08 

PEST 

109 

c 

PEST 

1  1  0 

PEST 

1  1  1 

PEST 

1  12 

PEST 

1  13 

PEST 

1  14 

PEST 

1  1  5 

PEST 

1  1  6 

PEST 

1  17 

PEST 

1  1  8 

PEST 

1  1  9 

PEST 

1  20 

c 

PEST 

121 

c 

PEST 

122 

c 

PEST 

123 

PEST 

1  24 

PEST 

125 

c 

PEST 

1  26 

c 

PEST 

1  27 

PEST 

1  28 

PEST 

1  29 

PEST 

1  30 

PEST 

1  31 

PEST 

132 

PEST 

133 

PEST 

134 

PEST 

135 

PEST 

136 

PEST 

137 

PEST 

138 

PEST 

1  39 

PEST 

140 

PEST 

141 

PEST 

142 

PEST 

143 

PEST 

144 

PEST 

145 

PEST 

146 

PEST 

147 

PEST 

148 

PEST 

149 

PEST 

150 

PEST 

151 
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SUBROUTINE  PEST  (Continued) 


5045 


505 


51  0 
C 

C  *  * 


512 


520 

C 

C  ** 


C  * 


NP  =  NREG ( MP ) 

DECODE  (  80 , 920, TEMP ) A1 , PI 
WR I TE (6, 920)A1  ,  PI 
WRITE (6, 960) IDD,  IN, JQ2 

PORA ( MP ,  1  ,  N )  =  PI  $  PORB ( MP ,  1  ,  N )  =  P0RC(MP,1,N>  =  0. 

DO  505  NQ= 1 , NP 

READ ( I N j  91 9 ) A1 ,  P2,  A2, DELP, A3,  YADDP (MP,  NO,  N) 

WRITE (6, 920 )A1 ,P2, A2, DELP, A3, YADDP ( MP, NQ, N) 

WRITEC6, 960) IDD, IN, JQ2 

IF  (NQ  .NE.  NP)  GO  TO  5045 

IF  (RHOP(MP, NP+1 , N)  .GT.  RHOS )  GO  TO  5045 

RHOP ( MP , NP+1 , N)  =  RHOS* ( 1 . +TSQE(0, P2, 0. , EQSTCM , EQSTDM, EQSTSM , 

1  EQSTGM, EQSTHM, EQSTEM, RHOS, EQSTNM, 0.  , EQSTVM, EQSTAM,  NCYC) ) 

WR I TE ( 6, 932 ) RHOP (MP, NP+1 , N) 

WRI TEC  6, 960) I DD, OUT, JQ2 

DRHO= RHOP ( MP , NQ+1 , N ) -RHOP ( MP , NQ , N) 

AA=P2-P 1 -4 . *DELP*RHOP ( MP , NQ , N) /DRHO 

PORACMP, NQ+1 , N ) =P1 +RHOP (MP, NQ+1 , N ) /DRHO* AA 

BB=P2-P1 -4. *DELP* ( RHOP (MP, NQ+1 , N)+RH0P(MP, NQ, N) ) /DRHO 

PORB (MP, NQ+1 , N ) = -RHOP ( MP, NQ+1 , N) *RHOP (MP, NQ, N) /DRHO*BB 

PORCCMP, NQ  +  1 , N)  =  -4. *DELP* ( RHOP ( MP , NQ  +  1 , N ) *RHOP (MP,  NQ , N ) /DRHO ) * * 2 

YADDP(MP, NQ, N)  =  YADDP ( MP , NQ, N ) /DRHO 

PI  =P2 

YADDP(MP, NP+1 , N)  =  0. 

RHOP ( MP , 5 , N )  =  RHGPCMP, NP+1 , N) 

GO  TO  600 
CONTINUE 

READ  AND  INITIALIZE  FOR  PORHOLT.  ** 

READ ( IN, 91 9)A1 , RHOP(MP, 1 , N) 

WRI TEC  6, 920 )A1 , RHOPCMP,  1 , N) 

READ ( IN, 91 9)A1 , RHOPCMP, 5, N) , A2, DPDRHO, A3, PY , A4 , YADDP (MP, 1 , N) 

WRI TEC  6, 920 )A1 , RHOPCMP, 5, N) , A2, DPDRHO, A3, PY , A4 , YADDP ( MP,  1 , N) 

WRI TEC  6, 960)  IDD,  IN, JQ15,  I DD , JQS , J2 , J3 , J4 
IF  (RHOPCMP,  5,  N)  . LT .  100.)  GO  TO  512 

P2  =  RHOP ( MP j  5, N ) 

RHOPCMP, 5, N ) =RHOS* ( 1 . +TSQE ( 0, P2, 0. , EQSTCM, EQSTDM, EQSTSM, EQSTGM, 

1  EQSTHM, EQSTEM, RHOS, EQSTNM, 0. , EQSTVM , EQSTAM, NCYC) ) 

WRI TEC 6, 932) RHOPCMP,  5,N) 

WRI TEC  6, 960) IDD, OUT,  JQ15 

RHOPCMP, 2, N) = RHOPCMP, 1 , N ) * ( PY/AK ( MP ) + 1 . ) 

RHOPCMP, 3, N) =RHCS/( 1 . - RHOS *PY/ RHOP ( MP, 2, N ) /EQSTCM) 

ALFE=RH0P ( MP, 3, N ) /RHOP ( MP , 2 , N ) 

R=RHOP ( MP , 3, N) -RHOS 

PORACMP,  1 , N)=ALFE*(ALFE* RHOPCMP, 2, N ) /EQSTCM* DPDRHO -R/RHOS ) 

R 1 =PORA( MP, 1 , N)/( RHOPCMP, 5, N ) -RHOP ( MP , 2, N) ) 

PORB ( MP, 1 , N)  =  (RHOPCMP, 5, N) -RHOP ( MP , 3,  N ) ) / 

1  (RHOPCMP, 5, N) -RHOPCMP, 2, N) ) **2-R1 
YADDP (MP,  1 , N)  =  YADDP (MP, 1 , N ) / ( RHOP ( MP , 5 , N ) -RHOP ( MP , 2 , N ) ) 

WR I TE ( 6, 930 ) 

IF  (N  .GE.  2)  GO  TO  640 

GO  TO  600 

CONTINUE 

READ  AND  INITIALIZE  FOR  CARROLL -HOLT .  ** 

READ ( I N,  91 9)A1 , YCH, A3, EPS ( MP , N ) , A4 , TER ( MP, 7, N) 

WRI TEC  6, 920) A1 , RHOPCMP,  1 , N ) , A2, YCH, A3, EPS ( MP , N ) , A4 , TERCMP, 7, N) 
WRI TEC  6, 960) IDD,  IN, JQ3, JQ4 , JQS , J2, J3, J4 
IF  ( A1  .EQ.  1 0H  YCH  =  )  GO  TO  525 

PY  =  YCH 

IF  CABS ( EPS (MP, N ) )  .LT.  1.)  GO  TO  526 
P2  =  EPS ( MP , N ) 

RV  = 1 . -RHOPCMP, 1 , N) /RHOS 

PY  AND  PC  KNOWN  * 

RHOPCMP, 5, N ) =RHOS* ( 1  . +TSQECO, P2, 0. , EQSTCM, EQSTDM,  EQSTSM,  EQSTGM, 

1  EQSTHM, EQSTEM, RHOS, EQSTNM, 0 . , EQSTVM, EQSTAM, NCYC) ) 

BB  =  BBMIN  =  (RHOPCMP, 5, N)/RH0S-1 . )*EQSTCM/PY 
ALFA  =  1 . /( 1 . -RV) 

DEL (MP, N )  =  PY/(EQSTCM*ALOG( 1 . -RHOPCMP, 1 , 1 )/RHOS) ) 

IF  (  YCH  .LT.  0.)  BBMIN  =  AMI N1 (BB, 1 . /DELCMP, N ) ) 

BBMIN  =  AMAX1 (BBMI N, 0 . 24627*ALFA**2+2 . 851 2*ALFA- 1 .9633) 

IF  (BB  .GT.  BBMIN)  GO  TO  521 
BB  =  BBMIN 

RHOPCMP, 5, N)  =  RHOS* ( 1 . +BB*PY/EQSTCM) 

EO  =  1 . /BB 


PEST 

1  52 

PEST 

1  53 

PEST 

154 

PEST 

1  55 

PEST 

1  56 

PEST 

1  57 

PEST 

158 

PEST 

159 

PEST 

1  60 

PEST 

161 

PEST 

162 

PEST 

163 

PEST 

164 

PEST 

165 

PEST 

166 

PEST 

1  67 

PEST 

1  68 

PEST 

1  69 

PEST 

1  70 

PEST 

171 

PEST 

1  72 

PEST 

1  73 

PEST 

1  74 

PEST 

1  75 

PEST 

1  76 

PEST 

1  77 

PEST 

1  78 

PEST 

179 

PEST 

1  80 

PEST 

181 

PEST 

1  82 

PEST 

1  83 

PEST 

1  84 

PEST 

1  85 

PEST 

186 

PEST 

1  87 

PEST 

188 

PEST 

1  89 

PEST 

1  90 

PEST 

1  91 

PEST 

1  92 

PEST 

193 

PEST 

1  94 

PEST 

195 

PEST 

1  96 

PEST 

197 

PEST 

198 

PEST 

199 

PEST 

200 

PEST 

201 

PEST 

202 

PEST 

203 

PEST 

204 

PEST 

205 

PEST 

206 

PEST 

207 

PEST 

208 

PEST 

209 

PEST 

210 

PEST 

21  1 

PEST 

212 

PEST 

213 

PEST 

214 

PEST 

215 

PEST 

216 

PEST 

217 

PEST 

218 

PEST 

219 

PEST 

220 

PEST 

221 

PEST 

222 

PEST 

223 

PEST 

224 

PEST 

225 

PEST 

226 

272 


SUBROUTINE  PEST  (Continued) 


WR I TE ( 6 , 927) 

PEST 

227 

GO  TO  5215 

PEST 

228 

521 

EO  =  RV*  *BB 

PEST 

229 

5215 

BO  =  ALOG ( EO ) /ALOG ( RV+EO ) 

PEST 

230 

E2=  El  =  (RV+EO)*#BB 

PEST 

231 

IF  (ABS(EO-EI)  .  LT.  1.E-05*E1)  GO  TO  524 

PEST 

232 

B1  =  AL0GCE1 ) /ALOG ( RV+E 1 ) 

PEST 

233 

NW  =  0 

PEST 

234 

522 

NW  =  NW+1 

PEST 

235 

E2  =  E 1 *EXP ( ( BB-B 1 ) * ( ALOG ( RV+E1 ) / ( 1 . -BB*E 1 / ( RV+E 1 ) ) ) ) 

PEST 

236 

B2  =  ALOG ( E2 ) /ALOG ( RV+E 2 ) 

PEST 

237 

AW  =  NW 

PEST 

238 

IF  (ABSCB2-B1)  .LT.  1 . E-5  .OR.  AW  .GE.  10.)  GO  TO  524 

PEST 

239 

EO  =  El  $  BO  =  B 1  $  El  =  E2  $  B1  =  B2 

PEST 

240 

GO  TO  522 

PEST 

241 

524 

EPS ( MP ,  N )  =  E2 

PEST 

242 

DEL ( MP , N )  =  (1 . -RHOP ( MP, 5, N) /RHOS) /ALOG ( EPS (MP,N) ) 

PEST 

243 

IF  (BB  .LE.  BBMIN)  GO  TO  5275 

PEST 

244 

GO  TO  528 

PEST 

245 

c  * 

YCH  AND  EPS  KNOWN 

* 

C 

PEST 

246 

525 

DEL ( MP , N )  =  0. 66667*YCH/EQSTCM 

PEST 

247 

IF  (YCH  .LT.  0.)  EPS ( MP ,  N )  =  AMAX1 ( EPS ( MP, N ) , ABS ( DEL ( MP, N ) ) ) 

PEST 

248 

PY  =  -  0 . 6666667* YCH* ALOG ( 1  . -RH0P(MP,  1 , N ) /RHOS+EPS ( MP,  N ) ) 

PEST 

249 

GO  TO  527 

PEST 

250 

C  * 

PY  AND  EPS  KNOWN 

* 

C 

PEST 

251 

526 

DEL ( MP , N) = -PY/EQSTCM/ ALOGC 1  .  -RHOP ( MP, 1 , N ) /RH0S  +  EPS ( MP ,  N) ) 

PEST 

252 

IF  (YCH  .LT.  0.)  EPS(MPJN)  =  AMAX1 ( EPS (MP, N) , ABS( DEL (MP, N ) ) ) 

PEST 

253 

527 

RHOP ( MP , 5 , N )  =  RHOS# ( 1 . -DEL ( MP , N )* ALOG ( EPS ( MP , N ) ) ) 

PEST 

254 

5275 

CALL  EQST ( 0 . , RHOP ( MP , 5 , N ) , P2 , M , 1 . ,A1 ,A2) 

PEST 

255 

C  * 

ALL  C-H 

* 

c 

PEST 

256 

528 

ALE ( MP  j  N )  =  DEL(MP,N)*ALOG(EPS(MP,N) ) 

PEST 

257 

APC ( MP , N )  =  RHOS/RHOP(MP, 5, N) 

PEST 

258 

WRITE (6, 925)PYJP2J  EPS ( MP,  N ) 

PEST 

259 

WRITE (6, 960) IDD, OUT, JQ3 , JQ4 

PEST 

260 

WR I TE ( 6, 932 ) RHOP (MP,  5,  N) 

PEST 

261 

WR I TE ( 6 , 960 )  I  DD , OUT, JQ3 ,  JQ4 

PEST 

262 

EPS ( MP, N )  =  1 . +EPS ( MP, N ) 

PEST 

263 

GO  TO  600 

PEST 

264 

530 

CONTINUE 

PEST 

265 

C 

c 

PEST 

266 

c  *  * 

READ  INPUT  AND  I  NIT  FOR  HERRMANN  P-ALPHA. 

#  # 

c 

PEST 

267 

READ ( IN, 919)A1  ,PC,  A3,PY 

PEST 

268 

WR I TE ( 6, 920 ) A1 ,RH0P(MP, 1 , 1 ) , A2, PC, A3, PY 

PEST 

269 

WRITE (6, 960) IDD, I N, JQ5, JQ6, JQS, J2 , J3 , J4 

PEST 

270 

PORA ( MP,  1 , N )  =  PY  $  PORC ( MP ,  1  ,  N )  =  PC 

PEST 

271 

GO  TO  600 

PEST 

272 

540 

CONTINUE 

PEST 

273 

C 

c 

PEST 

274 

C  #  * 

READ  AND  INIT  FOR  HENDRON. 

*  * 

c 

PEST 

275 

GO  TO  600 

PEST 

276 

550 

CONTINUE 

PEST 

277 

C 

c 

PEST 

278 

C  *  * 

READ  AND  INIT  FOR  TBS. 

## 

c 

PEST 

279 

GO  TO  600 

PEST 

280 

600 

IF  (N  .GE.  2)  GO  TO  640 

PEST 

281 

N  =  2 

PEST 

282 

J2=5HTENS  $  J3= J4= 1 H 

PEST 

283 

C 

c 

PEST 

284 

c  #  #  # 

READ  FOR  RATE- INDEPENDENT  TENSION  MODEL. 

*  *  * 

c 

PEST 

285 

c 

c 

PEST 

286 

IF  (KTSM  .EQ.  0  .AND.  KCSM  . EQ .  3)  GO  TO  610 

PEST 

287 

GO  TO  (615,620,520)  KTSM 

PEST 

288 

c 

c 

PEST 

289 

c  #  # 

REPEAT  CARROLL-HOLT  ARRAY  FOR  N=2. 

*  * 

c 

PEST 

290 

610 

ALE ( MP, 2 ) = -ALE ( MP, 1 )  $  EPS ( MP , 2 ) =EPS ( MP , 1 ) 

PEST 

291 

DEL ( MP, 2 )  =  -  DEL ( MP ,  1  )  $  TER(MP,7,2)  =  TER(MP,7,1) 

PEST 

292 

APC ( MP , 2 ) = 1 ./(I . -ALE ( MP, N ) ) 

PEST 

293 

RHOP ( MP, 5, N) = RHOS / APC (MP,  2) 

PEST 

294 

WRI TE( 6, 932) RHOP(MP,  5,  N) 

PEST 

295 

WR I TE ( 6 , 960) I DD,OUT, JQ3, JQ4, JQS, J2 

PEST 

296 

GO  TO  600 

PEST 

297 

615 

CONTINUE 

PEST 

298 

C 

c 

PEST 

299 

c  *  * 

READ  AND  INIT  FOR  VARIABLE  STRENGTH. 

PEST 

300 

READ ( IN, 91 9)A1 , TER ( MP, 5, N) , A2, TER (MP, 7, N) 

PEST 

301 
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SUBROUTINE  PEST  (Continued) 


WR I TE C6,920)A1 , TER  CMP, 5, N) , A2,  TER  CMP,  7,  N) 

PEST 

302 

WRITE (6. 960) IDD,  IN, JQ7, JQ8,  JQS, J2 

PEST 

303 

GO  TO  600 

PEST 

304 

620 

CONTINUE 

PEST 

305 

C 

C 

PEST 

306 

c  *  * 

READ  AND  I  NIT  FOR  K1C. 

J*c  J*C 

C 

PEST 

307 

READ( IN, 919)A1 ,  K1 C(MP) , A2, TER CMP, 7, N) 

PEST 

308 

WRITE (6, 920 )A1 ,  K1 C(MP) , A2,  TER CMP,  7,  N) 

PEST 

309 

WR I TE ( 6 , 960 ) IDD, IN, JQ9, JQ 1  0 , 

JQS, J2 

PEST 

310 

GO  TO  600 

PEST 

31  1 

640 

CONTINUE 

PEST 

312 

IF  (N  .EQ.  3)  GO  TO  700 

PEST 

31  3 

N  =  3 

PEST 

314 

J2=5HREC0M 

PEST 

31  5 

C 

C 

PEST 

31  6 

c  #  *  * 

READ  FOR  RATE- INDEPENDENT 

RECOMPRESSION  MODEL.  *** 

C 

PEST 

31  7 

c 

C 

PEST 

318 

IF  ( KRSM  , GT .  0)  GO  TO  660 

PEST 

319 

c 

C 

PEST 

320 

c  *  * 

REPEAT  ARRAYS  KRS=KCS. 

*  * 

C 

PEST 

321 

GO  TO  ( 641 , 645, 647, 648)  KCSM 

PEST 

322 

c 

C 

PEST 

323 

c  *  * 

POREQST . 

** 

C 

PEST 

324 

641 

NPP  =  NP+1 

PEST 

325 

DO  642  NQ  =  1  ,  NPP 

PEST 

326 

PORA ( MP , NO , 3 ) =PORA ( MP,  NQ,  1  ) 

$  YADDPCMP, NQ , 3 ) = YADDP ( MP, NQ, 1 ) 

PEST 

327 

PORB ( MP, NQ , 3 ) =  PORB ( MP, NQ , 1 ) 

$  PORC  C  MP , NQ, 3 ) =  PORC ( MP , NQ , 1  ) 

PEST 

328 

642 

CONTINUE 

PEST 

329 

DO  644  NQ= 1 , 5 

PEST 

330 

RHOPCMP, NQ, 3) = RHOPCMP,  NQ,  1  ) 

$  COSQCMP, NQ, 3 ) =COSQ ( MP , NQ, 1 ) 

PEST 

331 

Cl ( MP, NQ, 3 ) =C 1 ( MP, NQ, 1 ) 

PEST 

332 

644 

CONTINUE 

PEST 

333 

GO  TO  700 

PEST 

334 

C 

C 

PEST 

335 

c  *  * 

PORHOLT. 

*  # 

C 

PEST 

336 

645 

PORA ( MP , 1 , 3)=P0RA(MP,  1,1)  $ 

PORB CMP, 1 , 3)=P0RB(MP, 1,1) 

PEST 

337 

RHOPCMP, 5, 3)  =  RHOPCMP, 5,1) 

$  RHOPCMP, 2, 3)  =  RHOPCMP, 2,1) 

PEST 

338 

RHOPCMP, 3, 3)  =  RHOPCMP, 3,1) 

S  YADDPCMP, 1 , 3)  =  YADDP ( MP, 1 , 1 ) 

PEST 

339 

RHOPCMP, 1 , 3)=RH0PCMP, 1,1) 

PEST 

340 

GO  TO  700 

PEST 

341 

C 

C 

PEST 

342 

c  #  # 

CARROLL-HOLT  MODEL, 

*ft 

C 

PEST 

343 

647 

APCCMP, 3) =APC(MP, 1 )  $  EPS CMP, 3 ) =EPS( MP, 1 ) 

PEST 

344 

DEL ( MP, 3 )  =DEL ( MP, 1 )  $  RHOPCMP, 5, 3) =RHOP(MP, 5, 1 ) 

PEST 

345 

RHOPCMP, 1 , 3)=RH0P(MP, 1,1) 

PEST 

346 

GO  TO  700 

PEST 

347 

C  #* 

HERRMANN  P-ALPHA  MODEL. 

*  * 

C 

PEST 

348 

648 

PORA ( MP, 1,3)  =  PORACMP, 1,1) 

$  PORC ( MP, 1,3)  =  PORC ( MP, 1,1) 

PEST 

349 

RHOPCMP, 1,3)  =  RHOPCMP, 1,1) 

PEST 

350 

GO  TO  700 

PEST 

351 

660 

GO  TO  (490,510,520,530,540,550)  KRSM 

PEST 

352 

C 

C 

PEST 

353 

c  *  *  * 

READ  FOR  RATE  EFFECTS  IN 

COMPRESSION.  ##* 

C 

PEST 

354 

c 

C 

PEST 

355 

700 

N  =  1 

PEST 

356 

J2=5HC0MP,  $  J3= J4= 1 H 

PEST 

357 

IF  ( KTDM  .EQ.  0)  J3=5HTENS, 

$  IF  ( KRDM  .EQ.  0)  J4=5HREC0M 

PEST 

358 

IF  ( KCDM  .LE.  0)  GO  TO  750 

PEST 

359 

GO  TO  (750,720,730,740)  KCDM 

PEST 

360 

720 

CONTINUE 

PEST 

361 

C 

C 

PEST 

362 

C  *  * 

READ  AND  I  NIT  FOR  LINEAR 

VISCOUS  VO  I  DC C)  OR  DUCTILE  FRACTURE CT) 

PEST 

363 

READ ( I N, 909 )A1 ,  ( TER ( MP,  I  ,  N)  , 

1=1,7) 

PEST 

364 

WRITE (6, 910)A1 , ( TER ( MP, I,N), 

1=1,7) 

PEST 

365 

IF  (N  .EQ.  1  .OR.  N  .EQ.  3) 

WRI TEC  6, 960) IDD,  I N, JQ1 1 , JQ1 2, JQR, 

PEST 

366 

1  J2,J3,J4 

PEST 

367 

IF  (N  .EQ.  2)  WRITEC6, 960) IDD, I N, JQ1 7, JQ1 8, JQR, J2 

PEST 

368 

IF  ( TER ( MP, 8, N )  . EQ .  0 . ) TERC MP, 8, N ) =8 . *3 . 1 4 1  59*TER 

PEST 

369 

1  (MP, 3, N)*#3#TER(MP, 4, N) 

PEST 

370 

GO  TO  750 

PEST 

371 

730 

CONTINUE 

PEST 

372 

C 

C 

PEST 

373 

C  *  * 

READ  AND  INIT  DYNAMIC  PORHOLT.  ** 

C 

PEST 

374 

READC I N, 91 9) A1  ,TPH(MP,N) 

PEST 

375 

WR I TE ( 6, 920) A1 ,TPH(MP,N) 

PEST 

376 

274 


SUBROUTINE  PEST  (Continued) 


WRI TEC  6, 960) IDD,  I  N,  JQ1 3, JQ14, JQR, J2, J3, J4 

PEST 

377 

GO  TO  750 

PEST 

378 

740 

CONTINUE 

PEST 

379 

C 

C 

PEST 

380 

C  * 

READ  AND  I  NIT  DYNAMIC  BUTCHER  P-ALPHA-TAU. 

*  * 

C 

PEST 

381 

READ ( I N, 91 9) A1 , TPHCMP, N) 

PEST 

382 

WRI TEC  6, 920 )A1 , TPHCMP, N) 

PEST 

383 

DADP ( MPj N ) = -ALFO/AK ( MP ) * ( 1 . - AK ( MP ) * ALFO/EQSTCM ) 

PEST 

384 

WRI TEC  6, 960)  I DD,  I N , JQ1 3 , JQ1 6, JQR, J2, J3, J4 

PEST 

385 

750 

N  =  N  +  1 

PEST 

386 

C 

C 

PEST 

387 

C  *  *  * 

READ  FOR  RATE  EFFECTS  IN  TENSION. 

#  ## 

C 

PEST 

388 

c 

C 

PEST 

389 

GO  TO  C  700 , 755, 770 , 900 )  N 

PEST 

390 

755 

J2=  5HTENS 

PEST 

391 

IF  ( KTDM  .GT.  0)  GO  TO  C 750, 720, 760)  KTDM 

PEST 

392 

IF  CKCDM  .EG).  0 )  GO  TO  750 

PEST 

393 

C 

C 

PEST 

394 

c  *  * 

REPEAT  ARRAYS  KTD=KCD. 

*  * 

C 

PEST 

395 

IF  CKCDM  .EQ.  1 )  GO  TO  750 

PEST 

396 

IF  CKCDM  .GT.  2)  GO  TO  756 

PEST 

397 

c 

C 

PEST 

398 

c  *  * 

REPEAT  LINEAR  VISCOUS  VOID  FOR  DUCTILE  FRACTURE. 

*  * 

C 

PEST 

399 

TER ( MP,  1 , 2)=TER(MP,  1,1)  $  TERCMP, 2 , 2 ) = -TER ( MP , 2,1) 

PEST 

400 

TERCMP,  3,  2)  =  TER(MP,  3,  1  )  $  TER ( MP , 4 , 2 ) =TER ( MP, 4 , 1  ) 

PEST 

401 

TER ( MP, 5, 2 ) = -TER ( MP, 5, 1 )  $  TER ( MP , 6, 2 ) =TER ( MP , 6, 1 ) 

PEST 

402 

TERCMP, 7, 2)  =  TERCMP, 7,1)  $  TERCMP, 8, 2)  =  TERCMP, 8,1) 

PEST 

403 

GO  TO  750 

PEST 

404 

c 

C 

PEST 

405 

C  *  ft 

READ  BRITTLE  FRACTURE  AND  FRAGMENTATION. 

*  *  C 

PEST 

406 

756 

CONTINUE 

PEST 

407 

760 

CONTINUE 

PEST 

408 

GO  TO  750 

PEST 

409 

C 

C 

PEST 

410 

c  *  *  * 

READ  FOR  RATE  EFFECTS  IN  RECOMPRESSION. 

*  *  * 

C 

PEST 

41  1 

770 

J2  =  5HREC0M 

PEST 

412 

IF  (KRDM  .GT.  0)  GO  TO  800 

PEST 

413 

C 

C 

PEST 

414 

C  *  * 

REPEAT  ARRAYS  KRD=KCD  AS  FOLLOWS. 

*# 

C 

PEST 

415 

IF  CKCDM  .EQ.  0)  GO  TO  900 

PEST 

416 

GO  TO  C 900,  780,  785,  790)  KCDM 

PEST 

417 

c 

C 

PEST 

418 

c  *  * 

REPEAT  FOR  LINEAR  VISCOUS  VOID  COMPRESSION  MODEL. 

*  * 

C 

PEST 

419 

780 

TERCMP, 1 , 3)=TERCMP, 1,1)  $  TERCMP, 2, 3)=TERCMP, 2, 1 ) 

PEST 

420 

TERCMP, 3, 3)  =  TERCMP, 3,1)  $  TERCMP, 4,3)  =  TERCMP, 4,1) 

PEST 

421 

TERCMP, 5, 3)  =  TERCMP, 5,1)  $  TERCMP, 6,3)  =  TERCMP, 6,1) 

PEST 

422 

TERCMP, 7, 3)  =  TERCMP, 7,1)  $  TERCMP, 8, 3)  =  TERCMP, 8,1) 

PEST 

423 

GO  TO  900 

PEST 

424 

C 

C 

PEST 

425 

c  *  # 

REPEAT  FOR  DYNAMIC  PORHOLT  MODEL. 

*  * 

C 

PEST 

426 

785 

TPHCMP, 3)=TPH(MP, 1 ) 

PEST 

427 

GO  TO  900 

PEST 

428 

C 

C 

PEST 

429 

C  *  * 

REPEAT  FOR  BUTCHER  P-ALPHA-TAU  MODEL. 

*# 

C 

PEST 

430 

790 

TPHCMP, 3)=TPH(MP, 1 )  $  DADPC MP, 3) =DADP (MP, 1 ) 

PEST 

431 

GO  TO  900 

PEST 

432 

800 

GO  TO  (900,720,730,740)  KRDM 

PEST 

433 

900 

RETURN 

PEST 

434 

905 

FORMAT ( 8A1 0 ) 

PEST 

435 

909 

FORMAT ( A 1 0, 7E1 0. 3) 

PEST 

436 

910 

FORMAT ( A1 0, 1P7E10.3) 

PEST 

437 

915 

FORMAT (IX, 2A1 ) 

PEST 

438 

919 

FORMAT (4(A10,E10.3) ) 

PEST 

439 

920 

FORMAT  C  4  C  A 1 0,  1  PEI  0. 3) ) 

PEST 

440 

925 

FORMAT ( *  PY=  *  1  PE 10.3, *  PC=  *  1  PEI  0.3,*  EPS  =  * 1  PEI  0 . 3 ) 

PEST 

441 

927 

FORMAT (*  ABSOLUTE  VALUE  OF  CONSOLIDATION  PRESSURE  WAS  CHANGED  TO 

PEST 

442 

1 

1  BE  WITHIN  ALLOWABLE  RANGE* ) 

PEST 

443 

930 

FORMAT  C / ) 

PEST 

444 

932 

FORMAT  C  *  CONSOLIDATION  DENS I TY  =  * 1  PEI  0 . 3) 

PEST 

445 

935 

FORMAT ( 2 ( A 1 0, I 6, I 2, I 2) ) 

PEST 

446 

939 

FORMAT CA10, I10,A10,E10.3) 

PEST 

447 

940 

FORMAT (A10, I10,A10,1PE10.3) 

PEST 

448 

950 

FORMAT ( *  BULK  AND  SHEAR  MODULI  ARE  CHANGED  TO* 1 P2E1 2.3,* 

DYN/CM2* ) 

PEST 

449 

960 

FORMAT C 1H+,79X, 5H  I ND=A2,5H,  I N=I 2, A1 0, A9 , 4A5 ) 

PEST 

450 

C 

C 

PEST 

451 
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C  **** * * ******  * ******  * 

******************** 

C 

PEST 

452 

c 

COMPUTATION  OF  PRESSURE  DURING  WAVE  PROPAGATION. 

C 

PEST 

453 

c  *  ***  *  *  *  *  **  *  *  *  **  **  **  * 

******************** 

C 

PEST 

454 

c 

C 

PEST 

455 

1000 

MP  =  NPM ( M ) 

PEST 

456 

I  H  =  H 

PEST 

457 

c 

C 

PEST 

458 

c  #  * 

COMPUTE  BULK  AND  SHEAR  MODULI  APPROPRIATE  TO  CURRENT  E  AND  D. 

C 

PEST 

459 

c 

C 

PEST 

460 

TF  =  1 . +E*EQSTGM*RHOS/EQSTCM 

PEST 

461 

DREF  =  D*TF 

PEST 

462 

RVV1 =ABS ( RVV)  $  ALFD1 =1 . /( 1 . -RVV1 ) 

PEST 

463 

IF  (RVV  . LT . 0 .  .AND.  DREF/RHOS  . LT .  I.-ABS(RVV))  GO  TO  2000 

PEST 

464 

IF  (NCYC  .LE.  1)  ALFS  =  RHOS/RHOP CMP , 6 , 1 ) 

9/12/79 

1  3 

IFCF  .  EQ.  0. )  GO  TO  1800 

PEST 

466 

IF  (H  .EQ.  5R  S  .OR.  H  . EQ .  5R  M)  GO 

TO  1800 

PEST 

467 

RHOPV=RHOS/TF+(RHOP(MP, 5, 1 )-RHOS)*F 

PEST 

468 

RHOM=RHOP ( MP, 6, 1 )/TF 

PEST 

469 

ALF= AMAX1 (1.0, RHOPV/D)  $  ALFZ=RHOPV/RHOM 

PEST 

470 

ELK= ( EQSTCM/AK ( MP ) -ALFZ ) / ( ALFZ- 1 . ) 

PEST 

471 

ELG= ( 1 . “MUP ( MP ) *F/MUM ) / ( 1 . -1 ./ALFZ) 

PEST 

472 

BULK=EQSTCM*F/ ( ALF+ELK# ( ALF- 1 . ) ) 

PEST 

473 

MUM=AMAX1 (0. , MUM* ( 1 . -ELG+ELG/ALF ) ) 

PEST 

474 

C=SQRT ( (BULK+MUM ) /D ) 

PEST 

475 

IF  (NCYC  .EQ.  0)  PRINT  2300, D, BULK, MUM, C, F 

, ELK, ELG, RHOP ( MP,  6 ,  1  ) , 

9/12/79 

14 

1  E 

9/12/79 

15 

c 

C 

PEST 

477 

c  *  *  * 

COMPUTE  PRESSURE  FROM  ELASTIC  RELATIONS 

,  *  ** 

C 

PEST 

478 

PEL=P+BULK* ( ( D-DOLD ) / ( 0 . 5* ( D+DOLD ) ) +EQSTGM#RHOS/EQSTCM# ( E-EOLD ) ) 

PEST 

479 

c 

c 

PEST 

480 

c  *  * 

BRANCH  TO  TENSILE  OR  COMPRESSIVE  ROUTES 

,  #  * 

c 

PEST 

481 

c 

c 

PEST 

482 

IF  (PEL  .LT.  0. )  GO  TO  1500 

PEST 

483 

c 

c 

PEST 

484 

c  *  *  * 

COMPRESSION  PATH. 

*  *  * 

c 

PEST 

485 

c 

c 

PEST 

486 

KCRS=KCS ( MP )  $  N= 1 

PEST 

487 

IF  (H  .EQ.  5R  T)  H  =  5R  Q 

PEST 

488 

IF  (H  ,NE.  5R  Z  .AND.  H  .NE.  SR  R)  GO  TO  1090 

PEST 

489 

H  =  5R  R 

PEST 

490 

KCRS  =  KRS(MP) 

PEST 

491 

IF  (KRS(MP)  .EQ.  0)  KCRS  =  KCS(MP) 

PEST 

492 

N  =  3 

PEST 

493 

1  090 

GO  TO  (1100,1120,1140,1160,1180)  KCRS 

PEST 

494 

c 

c 

PEST 

495 

c  *  *  * 

CALCULATION  OF  COMPACTION  CURVE. 

*  ** 

c 

PEST 

496 

c 

c 

PEST 

497 

C  #  # 

POREQST  MODEL. 

** 

c 

PEST 

498 

1  1  00 

NC  =  0 

PEST 

499 

PST  =  0. 

PEST 

500 

IF  (DREF  .GT.  RHOP ( MP, 5, N ) ) GO  TO  1109 

PEST 

501 

1  1  05 

NC  =  NC+1 

PEST 

502 

IF  (DREF  .GT.  RHOP ( MP, NC, N ) )  GO  TO  1105 

PEST 

503 

PST  =  F*(PORA(MP, NC, N)+PORB(MP, NC, N ) /DREF+PORC ( MP , NC, N) /DREF*  *2) 

PEST 

504 

NQ  =  MAXO ( 1 , NC- 1 ) 

PEST 

505 

CZJ  =  COSQ(MP, NQ, N)  $  CWJ  *  C1(MP,NQ,N) 

PEST 

506 

YADDM  =  YADDP(MP, NQ, N) 

PEST 

507 

c 

c 

PEST 

508 

c  * 

CHECK  FOR  CONSOLIDATION  IN  LAST  POROUS 

REGION.  * 

c 

PEST 

509 

1  108 

IF  (DREF  .LT.  RHOS)  GO  TO  1300 

PEST 

510 

1  109 

GO  TO  ( 1 1 10, 1 1 1 2, 1 1 14)  NPRM 

PEST 

51  1 

1110 

CALL  EQST ( E, D, PS, M, CJ, DPDDJ, DPDEJ ) 

PEST 

51  2 

GO  TO  1118 

PEST 

513 

1112 

CALL  ESA ( 1 , 5,M, CJ, D, E, PS, DPDDJ, DPDEJ) 

PEST 

514 

GO  TO  1118 

PEST 

51  5 

1114 

CALL  EQSTPF ( 1 , 5 , M, CJ , D , E , PS ) 

PEST 

516 

1118 

IF  (PS  .LT.  PST)  GO  TO  1300 

PEST 

517 

PST  =  PS 

PEST 

51  8 

I H  =  5R  S 

PEST 

519 

IF  (PS  .LT.  PEL)  GO  TO  1300 

PEST 

520 

PJ  =  PS  $  H  =  5R  S  S  RVV  =  0. 

PEST 

521 

GO  TO  1900 

PEST 

522 

C 

c 

PEST 

523 

C  *  * 

PORHOLT  MODEL. 

*  * 

c 

PEST 

524 

1  120 

DREF= AMAX1 (DREF, RHOP(MP, 1 , N) ) 

PEST 

525 
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ALFS  =  (  RHOP(MP,  3, N) +(  PORA(MP,  1  J  N )  +PORB  ( MP ,  1  ,  N  )  *  (  DREF-RHOP  (  MP , 

2, 

N) 

PEST 

526 

1 ) ) x ( DREF-RHOP ( MP , 2, N) ) )/DREF 

PEST 

527 

ALFS=AMAX1 (ALFS, 1 . ) 

PEST 

528 

DS  =  ALFS*DREF 

PEST 

529 

GO  TO  (1126,1128,1130)  NPRM 

PEST 

530 

1  126 

CALL  EQST ( 0 . , DS, PS,M, CJ, DPDDJ, DPDEJ ) 

PEST 

531 

GO  TO  11 34 

PEST 

532 

1  1  28 

CALL  ESA ( 1 , 5, M, CJ, DS, 0. , PS, DPDDJ, DPDEJ) 

PEST 

533 

GO  TO  11 34 

PEST 

534 

1  1  30 

CALL  EQSTPF (  1 , 5,  M,  C J ,  DS,  0 . , PS) 

PEST 

535 

1  134 

PST  =  PS/ALFS*F 

PEST 

536 

YADDM  =  YADDP ( MP , 1 , N) 

PEST 

537 

GO  TO  1 1 08 

PEST 

538 

C 

C 

PEST 

539 

C  *  * 

CARROLL-HOLT  MODEL. 

X  X 

C 

PEST 

540 

1  140 

BNEW  =1.0 

PEST 

541 

IF  (DREF  .GT.  RHOP ( MP, 5, N ) )GO  TO  1143 

PEST 

542 

BNEW  =  BP  =  DREF/RHOS 

PEST 

543 

IF  (BNEW  .GT.  2.-1. /APC ( MP , N ) )  BNEW  =  1 . +0 . 5* ( BP- 1 . /APC (MP, N ) ) 

PEST 

544 

NW  =  0 

PEST 

545 

1  141 

B1  =  BP+DEL(MP, N) *ALOG( EPS(MP, N) -BNEW) 

PEST 

546 

BNEW  =  AM I N 1 ( BNEW+ ( B1 -BNEW ) / ( 1 . +DEL ( MP, N ) / ( EPS ( MP , N ) -BNEW ) ) , 0 . 

9999 

PEST 

547 

19999) 

PEST 

548 

NW  =  NW+1 

PEST 

549 

AW  =  NW 

PEST 

550 

IF  ( ABS ( BNEW-B1 )  .GT.  1 . E-6  .AND.  AW  . LT .  10.)  GO  TO  1141 

PEST 

551 

1  143 

DS  =  DREF/BNEW 

PEST 

552 

GO  TO  (1145,1147,1149)  NPRM 

PEST 

553 

1  145 

CALL  EQST ( 0 . , DS, PS, M, CJ , DPDDJ , DPDEJ ) 

PEST 

554 

GO  TO  1155 

PEST 

555 

1  147 

CALL  ESA ( 1 , 5, M, CJ, DS, 0. , PS, DPDDJ, DPDEJ) 

PEST 

556 

GO  TO  1 1 55 

PEST 

557 

1  149 

CALL  EQSTPF ( 1 , 5, M, CJ , DS, 0 . , PS) 

PEST 

558 

1  155 

PST  =  PS*BNEW*F 

PEST 

559 

GO  TO  11 08 

PEST 

560 

1  1  60 

CONTINUE 

PEST 

561 

C 

C 

PEST 

562 

C  xx 

HERRMANN  P-ALPHA. 

X  X 

C 

PEST 

563 

PST  =  0. 

PEST 

564 

DC  =  RHOS* ( PORC ( MP,  1  , N ) *F/EQSTCM-M  .  ) /TF 

PEST 

565 

DC  =  RHOS*( 1 . +TSQE(0,P0RC(MP, 1 , N)*F, EQSTGM*DC*E , EQSTCM, 

PEST 

566 

1  EQSTDMj  EQSTSMj EQSTGM, EQSTHM, EQSTEM, RHQS,  EQSTNM . E,  EQSTVM. EQSTAM 

PEST 

567 

2  NCY  C ) ) 

PEST 

568 

IF  (DC  . LT.  D)  GO  TO  1109 

PEST 

569 

DY  =  RHOP(MP, 1 , N)/TF*( 1 . +P0RA(MP, 1 , N) /AK(MP) ) 

PEST 

570 

ALFY  =  1 . / ( DY*TF/RHOS-PORA ( MP , 1 , N ) *F/EQSTCM) 

PEST 

571 

DD  =  AMAX1 (D, DY) 

PEST 

572 

DYD  =  DY*ALFY/DD 

PEST 

573 

DCD  =  DC/DD 

PEST 

574 

B1  =  ( DCD -DYD ) *  *2/ ( ALFY  -  1.) 

PEST 

575 

B2  =  DCD+B1/2. 

PEST 

576 

ALFS  =  B2-SQRT(B2*B2-DCD*DCD-B1 ) 

PEST 

577 

DS  =  ALFS*DD 

PEST 

578 

GO  TO  (1170,1172,1174)  NPRM 

PEST 

579 

1  170 

CALL  EQST ( E , DS, PS,M, CJ , DPDDJ , DPDEJ ) 

PEST 

580 

GO  TO  1178 

PEST 

581 

1  172 

CALL  ESA ( 1 , 5,M, CJ, DS, E, PS, DPDDJ, DPDEJ) 

PEST 

582 

GO  TO  1 1 78 

PEST 

583 

1  174 

CALL  EQSTPF( 1 , 5,M, CJ, DS, E, PS) 

PEST 

584 

1  1  78 

I F ( D  .GE.  DY)  GO  TO  1  179 

PEST 

585 

DYD  =  DY*ALFY/D 

PEST 

586 

DCD  =  DC/D 

PEST 

587 

B 1  =  (DCD-DYD)**2/( ALFY  -  1.) 

PEST 

588 

B2  =  DCD+B1/2. 

PEST 

589 

ALFS  =  B2-SQRT(B2*B2-DCD*DCD-B1  ) 

PEST 

590 

1  179 

PST  =  PS/ALFS 

PEST 

591 

IF  (PEL  .LT.  PST)  GO  TO  1300 

PEST 

592 

PJ  =  PST 

PEST 

593 

1  180 

CONTI NUE 

PEST 

594 

1  300 

PJ  =  PEL 

PEST 

595 

IF  (PST  .LT.  PEL)  PJ  =  PST 

PEST 

596 

C 

C 

PEST 

597 

C  x 

COMPUTE  RELATIVE  VOID  VOLUME. (RVV) 

X 

c 

PEST 

598 

C 

c 

PEST 

599 

PTH  =  TSQE( 1 , P J  *RHOS/D , EQSTGM*RHGS*E , EQSTCM, EQSTDM, EQSTSM , EQSTGM 

J 

PEST 

600 
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1  EQSTHM, EQSTEM , RHOS, EQSTNM, E , EQSTVM, EQSTAM, NCYC) 

PEST 

601 

IF  (PJ  .NE,  0.)  RVV=AMAX1 ( 1 . -PJ/PTH, 0. ) 

PEST 

602 

IF  (PJ  .EQ.  0.)  RVV=AMAX1 (0. , 1 . -D/PTH) 

PEST 

603 

ALFS= 1 . /( 1 . -RVV) 

PEST 

604 

IF  (ASTI  .EQ.  0.)  ASTI  =  ALFS 

PEST 

605 

IF  (PEL  .GT.  PST)  GO  TO  1310 

PEST 

606 

IF  (IH  .NE.  5R  S)  GO  TO  1900 

PEST 

607 

RVV  =  0.  $  H  =  5R  S  $  GO  TO  1900 

PEST 

606 

c 

C 

PEST 

609 

c  *  #  # 

DYNAMIC  PRESSURE. 

*  *  * 

C 

PEST 

610 

c 

C 

PEST 

61  1 

1310 

KCRD=KCD(MP) 

PEST 

612 

IF  (H  .EQ.  5R  R  .AND.  KRD(MP)  .NE.  0)  KCRD  =  KRD(MP) 

PEST 

613 

IF  (KCRD  . GT. 1 )  GO  TO  1320 

PEST 

614 

C 

C 

PEST 

61  5 

c  *  * 

NO  RATE-DEPENDENCE. 

#  # 

C 

PEST 

61  6 

IF  ( IH  .EQ.  5R  S)  H  =  5R  S 

PEST 

61  7 

GO  TO  1900 

PEST 

61  8 

1320 

PELS=TSQE ( 1 , PEL*RHOS/D , EQSTGM*RHOS*E , EQSTCM , EQSTDM , EQSTSM , EQSTGM , 

PEST 

619 

1  EQSTHM, EQSTEM, RHOS, EQSTNM ,  E, EQSTVM, EQSTAM , NCYC ) 

PEST 

620 

IF  (PEL  .NE.  0.)  ALFL=PELS/PEL 

PEST 

621 

IF  (PEL  , EQ , 0 . )  ALFL=PELS/D 

PEST 

622 

ALFSD  =  (ALFS-AST1 )/DT 

PEST 

623 

ALFLD  =  ( ALFL  -  ALFD15/DT 

PEST 

624 

GO  TO  ( 1 900 , 1340, 1 380,  1440)  KCRD 

PEST 

625 

C 

C 

PEST 

626 

c  *  * 

LINEAR  VISCOUS  VOID  COMPACTION. 

#  * 

C 

PEST 

627 

1340 

VVE  =  1.-1. /ALFL 

PEST 

628 

DV  =  DVO  =  1 . /D-1 . /DOLD 

PEST 

629 

NL00P=MAX1 ( 1 . , -DV# EQSTCM* D/AMAX1 (PST, P)/ALF+0. 8, -4 . *TER ( MP, 

1 , N ) *DT 

PEST 

630 

1  # ( P-PST 1 ) ) 

PEST 

631 

VOLD  =  1 . /DOLD  $  VSO  =  ( 1 . -RVV1 ) /DOLD 

PEST 

632 

NTRY  =  0 

PEST 

633 

RVVL  =  RVV1 

PEST 

634 

PTHL  =  PTHO  =  PST 1 #AST 1 

PEST 

635 

PSO  =  AMAX1 ( P , PST 1 ) / ( 1 . -RVV1 ) 

PEST 

636 

IF  ( PST 1  .LT.  0.)  PSO a PTHL = PTHO =0 . 

PEST 

637 

IF  (1.-  RVV1  -  1 , /ASTI  .LT.  0.  .AND.  PSO  . GT .  PTHO)  GO  TO 

1  3401 

PEST 

638 

RVPO  =  -1 . / ( DOLD#EQSTCM ) 

PEST 

639 

DRVP  =  0. 

PEST 

640 

GO  TO  13403 

PEST 

641 

13401 

RVPO  =  ( 1 . -RVV1 -1 . /ASTI ) /DOLD/( PSO -PTHO) 

PEST 

642 

DRVP  =  ( RVV -VVE ) /D/ ( PELS- PTH ) -RVPO 

PEST 

643 

13403 

VSTHO  =  1 . / ( DOLD#AST 1 ) 

PEST 

644 

IF  ( PST1  .LE.  0.  .OR.  PST1  .GT.  P)  PTH L= PTHO = PTH 

PEST 

645 

DVSTH  =  ( 1 . -RVV)/D-VSTHO 

PEST 

646 

DVDP  =  ( VVE/ D- RVV 1 /DOLD ) / ( PELS -PSO ) 

PEST 

647 

DPTH  =  PTH -PTHO 

PEST 

648 

1341 

DELV  =  DV/NLOOP  $  VH  =  VOLD  S  DTN  =  DELV/DVO*DT 

PEST 

649 

A1  =  TER ( MP, 1 , N ) *DTN 

PEST 

650 

C 

BEGIN  DO  LOOP  FOR  SUBCYCLING 

PEST 

651 

DO  1 347  NL  =  1 , NLOOP 

PEST 

652 

VH  =  VH+DELV  $  RATIO  =  ( VH- 1 . /DOLD ) /DVO 

PEST 

653 

RVP  =  RVPO  +  DRVP# RAT  I 0 

PEST 

654 

VSTH  =  VSTHO+DVSTH*RAT I 0 

PEST 

655 

PTHH  =  PTHO+DPTH*RAT I 0 

PEST 

656 

C 

FIRST  ESTIMATE  OF  PRESSURE  IN  SOLID 

PEST 

657 

DP  =  AMAX1 ( 0 .  , PSO -PTHL ) 

PEST 

658 

XG  =  1 .  $  IF  (DP  .GE.  0.)  XG  =  EXP(A1#DP) 

PEST 

659 

PLO  =  PTHH  $  PUP  =  PELH  =  AMAX1 ( P , PST 1 )/( 1 . -RVV1 )+( PELS -AMAX1 ( P, 

PEST 

660 

1  PST1 )/(1 . -RVV1 ) ) *RAT I 0 

PEST 

661 

PSA  =  PELH  $  2G  =  RVVL# VH 

PEST 

662 

IF  (PTHH  .GT.  PELH)  GO  TO  1346 

PEST 

663 

PSJ  =  (DELV+VSO-VSTH+PTHH*RVP+PSO*DVDP-RVVL*VH#(XG*( 1 .+A1/2 

.  # 

PEST 

664 

1  ( -PTHH- PSO +PTHL ) ) -1 . ) ) / ( RVP+DVDP+RVVL*VH*XG*A1 /2 . ) 

PEST 

665 

NC  =  0 

PEST 

666 

1342 

NC  =  NC+1 

PEST 

667 

DP  =  ( AMAX1 ( 0 .  , PSJ -PTHH ) +AMAX1 ( 0 .  , PSO -PTHL ) ) /2 . 

PEST 

668 

ZG  =  RVVL*VH  $  IF  (DP  . GE .  0.)  ZG  *  ZG*EXP ( A1 * DP ) 

PEST 

669 

DELVA  =  VSTH -VSO+RVP# ( PSJ -PTHH ) +DVDP# ( PSJ -PSO ) +ZG-RVVL*VH 

PEST 

670 

PSA  =  PSJ 

PEST 

671 

AC  =  NC 

PEST 

672 

IF  ( ABS ( DELVA -DELV )  . LT .  1.E-5*VH  .OR.  (PSJ  . LE .  PTHH  .AND. 

AC 

PEST 

673 

1  .GT.  1 . ) )  GO  TO  1346 

PEST 

674 

IF  (NC  .GE.  10)  GO  TO  1348 

PEST 

675 
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IF  (DELVA  .GT.  DELV )  PLO  =  AMAX1 ( PSA , PLO ) 

PEST 

676 

IF  (DELVA  .LT.  DELV)  PUP  =  AM I N 1 C PSA,  PUP ) 

PEST 

677 

c 

MAKE  2ND  ESTIMATE  OF  PRESSURE  IN  THE  SOLID 

PEST 

678 

IF  ( MOD ( NC , 2 )  .EQ.  0)  GO  TO  1343 

PEST 

679 

PSJ  =  PS  J  + ( DELV -DELVA ) / ( RVP+DVDP+ZGxAl /2 . ) 

PEST 

680 

GO  TO  1344 

PEST 

681 

c 

INTERPOLATION  ESTIMATE  OF  PRESSURE  IN  SOLID 

PEST 

682 

1  343 

PSJ  =  PSA+ ( DELV -DELVA ) / ( DELVB- DELVA ) x ( PSB-PSA ) 

PEST 

683 

1  344 

CONTINUE 

PEST 

684 

IF  (PSJ  .GT.  PUP)  PSJ  =  PUP-1. E7 

PEST 

685 

IF  (PSJ  .LT.  PLO)  PSJ  =  PL0+1.E7 

PEST 

686 

I F  ( NC  . EQ .  1 )  GO  TO  1 345 

PEST 

687 

IF  ( ABS ( DELVA-DELV )  .GT.  ABS ( DELVB -DELV ) )  GO  TO  1342 

PEST 

688 

1  345 

PSB  =  PSA  $  DELVB  =  DELVA  $  GO  TO  1 342 

PEST 

689 

C 

CONCLUSION  OF  LOOP 

PEST 

690 

1  346 

RVVL  =  ZG/VH  $  PTHL  =  PTHH  $  PSA  =  PSO  =  AMAX1  ( PTHH , AM  I N 1 

PEST 

691 

1  ( PELH , PSA ) ) 

PEST 

692 

VSO  =  VH-ZG  $  ENT  =  ENTx VOLD/VH 

PEST 

693 

1  347 

CONTINUE 

PEST 

694 

PJ  =  (  1  .  -RVVDXPSA  $  RVV  =  RVVL  $  GO  TO  1900 

PEST 

695 

C 

PROVISION  FOR  ABORT  FOR  ITERATION  FAILURE 

PEST 

696 

1  348 

NTRY  =  NTRY+1  $  IF  ( NTRY  .GE.  5)  GO  TO  1349 

PEST 

697 

VOLD  =  VH -DELV  $  DV  =  1./D-V0LD 

PEST 

698 

NLOOP  =  MAXI (3. , -2. xxNTRYxDVxEQSTCMxD/AMAXI (PST, P)/ALF+0. 8) 

PEST 

699 

GO  TO  1341 

PEST 

700 

1349 

WR I TE ( 6  , 2349 )M, P, DV, DELVA, DELVB 

PEST 

701 

GO  TO  1346 

PEST 

702 

C 

C 

PEST 

703 

c  #  x 

PORHOLT  MODEL  -  DYNAMIC.  *  *  C 

PEST 

704 

1  380 

ALFD  =  TPH ( MP , N ) x ALFLD  +AST1  +ALFSDX ( DT-TPH ( MP, N ) ) + ( ALFD1 -TPH ( 

PEST 

705 

1  MP, N ) xaLFLD-ASTI +TPH ( MP, N ) xALFSD) xEXP( -DT/TPH ( MP,  N ) ) 

PEST 

706 

1  382 

DS  =  ALFDxD 

PEST 

707 

GO  TO  (1385,1390,1395)  NPRM 

PEST 

708 

1  385 

CALL  EQST ( E, DS, PS, M, CJ, DPDDJ , DPDEJ ) 

PEST 

709 

GO  TO  1400 

PEST 

71  0 

1  390 

CALL  ESA ( 1 , 5,M, CJ, DS, E, PS, DPDDJ, DPDEJ) 

PEST 

71  1 

GO  TO  1400 

PEST 

71  2 

1395 

CALL  EQSTPF ( 1 , 5, M, CJ , DS, E, PS ) 

PEST 

71  3 

1400 

P J  =  AM I N1  (PEL, AMAX1  ( PST,  PS/ALFD ) ) 

PEST 

714 

PS 1 =TSQE ( 1 , PJxRHOS/D, EQSTGM*RHOSxE , EQSTCM, EQSTDM, EQSTSM , EQSTGM, 

PEST 

71  5 

1  EQSTHM, EQSTEM, RHOS, EQSTNM , E, EQSTVM, EQSTAM, NCYC) 

PEST 

716 

IF  (PJ  .NE.  0.)  RVV=AMAX1 (0. , 1 . -PJ/PS1 ) 

PEST 

71  7 

IF  (PJ  .EQ.  0.)  RVV=AMAX1 (0. , 1 . -D/PS1 ) 

PEST 

71  8 

GO  TO  1900 

PEST 

71  9 

C  x  x 

BUTCHER  P-ALPHA-TAU  *x  C 

PEST 

720 

1440 

CONTINUE 

PEST 

721 

BT  =  TPH ( MP , N ) x ( ALFL -ALFS ) /DADP (MP, N)/(PEL-PST) 

PEST 

722 

ALFD=( (ALFL-ALFD1 ) XBT/DT-ALFS+ALFD1 ) xEXP ( DT/BT ) +ALFS -( ALFL -ALFD 1 )x 

PEST 

723 

1  BT/DT 

PEST 

724 

IF  (ALFD  .LT.  ALFS)  ALFD  =  ALFS 

PEST 

725 

IF  (ALFD  .GT.  ALFL)  ALFD  =  ALFL 

PEST 

726 

GO  TO  1382 

PEST 

727 

C 

C 

PEST 

728 

c  x xx 

TENSILE  PATH.  ***  C 

PEST 

729 

c  xx 

STATIC  FRACTURE  THRESHOLD  CURVE.  **  c 

PEST 

730 

c 

C 

PEST 

731 

1500 

KTSS  =  KTS(MP) 

PEST 

732 

I F ( KTSS  .EQ.  0)  KTSS  =  KCS(MP) 

PEST 

733 

N  =  2 

PEST 

734 

GO  TO  (1520,1540,1560)  KTSS 

PEST 

735 

C 

C 

PEST 

736 

C  X  x 

VARIABLE  STRENGTH. 

PEST 

737 

1520 

PTH  =  TER(MP,5,N)xF 

PEST 

738 

PST  =  D*PTHx(1 ./RH0S+EQSTGM*E/EQSTCM)/(1 . +PTH/EQSTCM ) 

PEST 

739 

GO  TO  1600 

PEST 

740 

C 

C 

PEST 

741 

C  x  x 

FRACTURE  MECHANICS.  **  c 

PEST 

742 

1  540 

GO  TO  1520 

PEST 

743 

C 

C 

PEST 

744 

C  xx 

CARROLL-HOLT  THRESHOLD  STRESS.  **  c 

PEST 

745 

1560 

PST  =  PEL 

PEST 

746 

IF  (DREF  .GT.  RHOP ( MP , 5, N ) )  GO  TO  1600 

PEST 

747 

BNEW  =  BP  =  DREF/RHOS 

PEST 

748 

NW  =  0 

PEST 

749 

1  565 

B1  =  BP+DEL(MP, N)XAL0G(EPS(MP, N) -BNEW) 

PEST 

750 
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SUBROUTINE  PEST  (Continued) 


BNEW  ■  AMIN1 (BNEW+CBl -BNEW)/C 1 . +DEL(MP, N)/(EPS(MP, N) -BNEW) ) ,0.9999 
1 9999) 

NW  =  NW+1 
AW  =  NW 

IF  (ABSCBNEW-B1 )  . GT .  1 . E-6  .AND.  AW  . LT .  10.)  GO  TO  1565 

DS  =  DREF/BNEW 
GO  TO  ( 1570, 1 572 , 1 574 )  NPRM 
1570  CALL  EQSTCO. , DS, PS, M, CJ , DPDD J , DPDEJ ) 

GO  TO  1580 

1572  CALL  ESA (1 , 5 , M , CJ , DS , 0 . , PS, DPDD J , DPDE J ) 

GO  TO  1580 

1574  CALL  EQSTPFC 1 , 5, M, CJ, DS, 0. , PS) 

1580  PST  =  PS*BNEW*F 

IF  (PST  .GT.  PS)  GO  TO  1600 
PST  =  PS 
I H  =  5R  S 

IF  (PEL  .GT.  PS)  GO  TO  1600 
PJ  =  PS 

H  =  5R  S  $  RVV  =  0. 

GO  TO  1900 
1600  PJ  =  PEL 

IF  (H  .NE.  5R  S)  H  =  5R  T 
IF  (PEL  .LT.  PST)  H  =  5R  T 
IF  (PEL  .LT.  PST)  PJ  =  PST 

C 

*#  COMPUTE  RELATIVE  VOID  VOLUME. (RVV)  **  C 

C 

PTH=TSQE ( 1 , PJ*RHOS/D, EQSTGM*RHOS*E, EQSTCM, EQSTDM,  EQSTSM,  EQSTGM, 

1  EQSTHM, EQSTEM, RHOS, EQSTNM , E, EQSTVM, EQSTAM, NCYC) 

IF  (PJ  .NE.  0.)  RVV  =  AMAX1 (0. , 1 . -PJ/PTH) 

IF  (PJ  .EQ.  0.)  RVV=AMAX1 (0. , 1 . -D/PTH) 

ALFS  =  1 . /( 1 . -RVV) 

IF  (RVV  .GT.  TER (MP, 7 , N) )  GO  TO  2000 
IF  (PEL  .GE.  PST)  GO  TO  1900 

C 

##  DYNAMIC  TENSILE  PRESSURE.  **  C 

C 

KTDD  *  KTD(MP) 

IF  (KTDD  .EQ.  0)  KTDD  =  KCD(MP) 

IF  (KTDD  .EQ.  0  .AND.  KCDM  . EQ .  0)  KTDD  «  1 
GO  TO  (1615,1620,1660)  KTDD 

C 

##  NO  RATE  DEPENDENCE.  **  C 

615  PJ  =  PST 

GO  TO  1635 

C 

**  N.  A.  G.  DUCTILE  FRACTURE  MODEL.  **  C 

1620  DV  =  DVO  =  1./D-1./D0LD 

VVE  =1 . -PEL/TSQE ( 1 , PEL#RHOS/D, EQSTGM* RHOS* E, EQSTCM, EQSTDM , EQSTSM, 

1  EQSTGM, EQSTHM, EQSTEM, RHOS, EQSTNM, E, EQSTVM, EQSTAM, NCYC) 

IF  (ASTI  .EQ.  0.)  ASTI  =  ALFS 
PELS  =  PEL/ ( 1 . -VVE) 

NL00P*MAX1 (1 . , -DV*EQSTCM*D/AMIN1 ( PST , P) /ALF+O . 8, 4 . * TER ( MP, 1 ,N)*DT 
1  * ( P-PST1 ) ) 

VOLD  *  1./D0LD  *  VSO  =  ( 1 . -RVV1 ) /DOLD 

NTRY  *  0 
RVVL  =  RVV1 

PTHL  =  PTHO  =  PST1 *AST 1 

PSO  =  AM INI  ( P , PST  1 ) / ( 1  . - RVV 1  ) 

I F ( PST 1  .GT.  0.)  PSO= PTHL=PTHO=0 . 

IF  (1.-  RVV1  -  1 . /ASTI  .GT.  O..AND.  PSO  . LT .  PTHO)  GO  TO  16201 
DRVP  =  0. 

RVPO  ■  -1 . / ( DOLD*EQSTCM ) 

GO  TO  16203 

16201  RVPO  *  ( 1 . -RVV1 - 1 . /ASTI ) /DOLD/ ( PSO -PTHO) 

DRVP  =  ( RVV -VVE ) /D/ ( PELS -PTH ) -RVPO 
16203  VSTHO  ■  1 ./( DOLD* AST 1 ) 

DVSTH  »  (1 . -RVV5/D-VSTH0 

DVDP  *  ( VVE/D-RVV1 /DOLD ) / ( PELS -PSO) 

IF  ( PST 1  .EQ.  0.  .OR.  PST1  . LT .  P)  PTHL  ■  PTHO  =  PTH 
DPTH  =  PTH-PTHO 

1621  DELV  ■  DV/NLOOP  $  VH  «  VOLD  $  DTN  ■  DELV/DVO*DT 
A1  =  TER ( MP, 1 , N) *DTN 

C  BEGIN  DO  LOOP  FOR  SUBCYCLING 

DO  1632  NL  =  1 , NLOOP 


PEST 

751 

PEST 

752 

PEST 

753 

PEST 

754 

PEST 

755 

PEST 

756 

PEST 

757 

PEST 

758 

PEST 

759 

PEST 

760 

PEST 

761 

PEST 

762 

PEST 

763 

PEST 

764 

PEST 

765 

PEST 

766 

PEST 

767 

PEST 

768 

PEST 

769 

PEST 

770 

PEST 

771 

PEST 

772 

PEST 

773 

PEST 

774 

PEST 

775 

PEST 

776 

PEST 

777 

PEST 

778 

PEST 

779 

PEST 

780 

PEST 

781 

PEST 

782 

PEST 

783 

PEST 

784 

PEST 

785 

PEST 

786 

PEST 

787 

PEST 

788 

PEST 

789 

PEST 

790 

PEST 

791 

PEST 

792 

PEST 

793 

PEST 

794 

PEST 

795 

PEST 

796 

PEST 

797 

PEST 

798 

PEST 

799 

PEST 

800 

PEST 

801 

PEST 

802 

PEST 

803 

PEST 

804 

PEST 

805 

PEST 

806 

PEST 

807 

PEST 

808 

PEST 

809 

PEST 

810 

PEST 

81  1 

PEST 

81  2 

PEST 

813 

PEST 

814 

PEST 

815 

PEST 

816 

PEST 

817 

PEST 

818 

PEST 

61  9 

PEST 

820 

PEST 

821 

PEST 

622 

PEST 

623 

PEST 

624 

PEST 

625 
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SUBROUTINE  PEST  (Continued) 


c 

1622 


1  623 

1624 


C 

C 

1625 

1626 

1627 

C 

1630 

1  632 

1635 

C 

1  640 

1643 

C 

1  660 

*  x 

1  600 
1  605 

1  81  0 

1  81  5 
1840 


VH  =  VH+DELV  $  RATIO  =  (VH~1 . /DOLD)/DVO 

PEST 

826 

RVP  =  RVPO+DRVP*RAT I 0 

PEST 

827 

VSTH  =  VSTHO+DVSTH*RAT I 0 

PEST 

828 

PTHH  =  PTH0+DPTH*RAT I 0 

PEST 

829 

FIRST  ESTIMATE  OF  PRESSURE  IN  SOLID 

PEST 

830 

DP  =  AM I N1 ( 0 . j PSO-PTHL ) 

PEST 

831 

XG  =  1 .  $  XN  =  0 . 

PEST 

832 

IF  (DP  .GE.  0. )  GO  TO  1622 

PEST 

833 

XG  =  EXP ( A1 *DP ) 

PEST 

834 

XN  =  EXP ( DP/TER ( MP, 6 ,  N  )  ) 

PEST 

835 

PLO  =  PTHH  $  PUP  =  PELH  =  AM  INI  ( P , PST1  ) / ( 1  , -RVV1  )  +  ( PELS -AM INI (  P, 

PEST 

836 

1  PST 1 1/(1 . -RVV1 ) ) *RAT I 0 

PEST 

837 

ZG  =  RWLWH  $  ZN  =  0.  $  PSA  =  PELH 

PEST 

838 

IF  (PTHH  .LT.  PELH )  GO  TO  1630 

PEST 

839 

PSJ  =  ( DELV+VSO-VSTH+PTHH*RVP+PSO*DVDP-RWL*VH* (XG* ( 1 . +A1 /2 . * 

PEST 

840 

1  ( -PTHH-PSO+PTHL) )  -1  .  ) -TER (MP , 8, N ) *VH*  DTN*XN* ( 1  . -(PTHH+PSO- 

■PTHL)/ 

PEST 

841 

2  2.  /TER  (  MP ,  6,  N)  )  )  /  (  RVP+DVDP+RWL*  VH*XG*A1  /2.  +TER(MPJ  8,  N  )  * VH*DTN* 

PEST 

842 

3  XN/2 . /TER (MP , 6, N) ) 

PEST 

843 

NC  =  0 

PEST 

844 

NC  =  NC+1 

PEST 

845 

DP  =  (AMI N1 ( 0 . 4  PSJ-PTHH) +AM I N1 ( 0 . , PSO-PTHL) ) /2 . 

PEST 

846 

ZG  =  RVVL*VH  $  ZN  =  0. 

PEST 

847 

IF  (DP  .GE.  0. )  GO  TO  1624 

PEST 

848 

ZG  =  ZG*EXP(A1 *DP) 

PEST 

849 

ZN  =  TER(MP, 8,  N) *VH*DTN*EXP( DP/ 2. /TER(MPJ  6,  N)  ) 

PEST 

850 

DELVA  =  VSTH- VSO+RVP*  (  PSJ-PTHH )  +DVDP*  (  PSJ  -PSO )  +ZG-RVVLKVH+ZN 

PEST 

851 

PSA  =  PSJ 

PEST 

852 

AC  =  NC 

PEST 

853 

IF  ( ABS ( DELVA -DELV )  LT.  1 . E-5*VH  .OR.  (PSJ  . GE  PTHH  .AND. 

AC 

PEST 

854 

1  . GT.  1 . ) )  GO  TO  1 630 

PEST 

855 

IF  (NC  .GE.  10)  GO  TO  1640 

PEST 

856 

IF  (DELVA  .LT.  DELV)  PLO  =  AM I N1 ( PLO, PSA) 

PEST 

857 

IF  (DELVA  .GT.  DELV)  PUP  =  AMAX 1 ( PSA, PUP ) 

PEST 

858 

MAKE  2ND  ESTIMATE  OF  PRESSURE  IN  THE  SOLID 

PEST 

859 

IF  ( MOD ( NC , 2 )  .EQ.  0)  GO  TO  1625 

PEST 

860 

PSJ  =  PSJ+(DELV-DELVA)/(RVP+DVDP+ZG*A1/2.+ZN/2./TER(MPJ6JN) ) 

PEST 

861 

GO  TO  1626 

PEST 

862 

INTERPOLATION  ESTIMATE  OF  PRESSURE  IN  SOLID 

PEST 

863 

PSJ  =  PSA+( DELV -DELVA) / ( DELVB- DELVA) * ( PSB-PSA) 

PEST 

864 

IF  (PSJ  .LT.  PUP)  PSJ  =  PUP+1.E7 

PEST 

865 

IF  (PSJ  .GT.  PLO)  PSJ  =  PL0-1.E7 

PEST 

866 

IF  (NC  .EQ.  1 )  GO  TO  1627 

PEST 

867 

IF  ( ABS ( DELVA -DELV )  .GT.  ABS ( DELVB -DELV ) )  GO  TO  1623 

PEST 

868 

PSB  =  PSA  $  DELVB  =  DELVA 

PEST 

869 

GO  TO  1623 

PEST 

870 

CONCLUSION  OF  LOOP 

PEST 

871 

RVVL  =  ( ZG+ZN ) /VH  $  PTHL  =  PTHH  $  PSA=PSO= AM I N1 (PTHH, 

AMAX1 

PEST 

872 

1  (PELH, PSA)) 

PEST 

873 

VSO  =  VH-ZG-ZN 

PEST 

674 

ENT  =  ENT  * VOLD/VH+TER ( MP ,  4  ,  N )  *  EXP (DP/2. /TER( MP ,6, N ) ) *DTN 

PEST 

875 

CONTINUE 

PEST 

876 

PJ  =  ( 1  .  -RVVL ) *  PSA 

PEST 

877 

RVV  =  RVVL 

PEST 

878 

IF  (RVV  .GT.  TER ( MP , 7 ,  N  )  )  GO  TO  2000 

PEST 

879 

GO  TO  1900 

PEST 

880 

PROVISION  FOR  ABORT  FOR  ITERATION  FAILURE 

PEST 

881 

NTRY  =  NTRY+1 

PEST 

882 

IF  (NTRY  .GE.  5)  GO  TO  1643 

PEST 

883 

VOLD  =  VH -DELV  $  DV  =  1./D-VGLD 

PEST 

884 

NLOOP  =  MAX 1  (3. ,  -2. *  *NTRY*  DV*EQSTCM*D/AM I N 1  ( PST, P ) / ALF+O . 8 ) 

PEST 

865 

GO  TO  1621 

PEST 

886 

WR I TE ( 6 , 2349 )M, P, DV, DELVA, DELVB 

PEST 

887 

GO  TO  1630 

PEST 

888 

BRITTLE  FRACTURE  AND  FRAGMENTATION. 

PEST 

889 

GO  TO  1900 

PEST 

890 

C 

PEST 

891 

SOLID  AND  POROUS  MELT  AND  SOLID  BEHAVIOR 

xx  c 

PEST 

892 

C 

PEST 

893 

GO  TO  (1805,1810,1615)  NPRM 

PEST 

894 

CALL  EQSTCE, D, PS, M, C, DPDDJ, DPDEJ ) 

PEST 

895 

GO  TO  1840 

PEST 

896 

CALL  ESA ( 1 ,5,M,C,D,E, PS , DPDDJ, DPDEJ) 

PEST 

897 

GO  TO  1840 

PEST 

898 

CALL  EQSTPF (1 ,5,M,C,D,E,PS) 

PEST 

899 

IF  (H  .NE.  5R  S)  GO  TO  1850 

PEST 

900 
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SUBROUTINE  PEST  (Concluded) 


IF  (F  ,EQ.  0. )  GO  TO  1850 

PJ=PST»PEL=PS 

GO  TO  1860 

1850  PJ  *  PST  =  PEL  =  AMAX1 ( 0 . ,  PS) 

IF  (PJ  .GT.  0. )  GO  TO  1855 

PTH  =  TSQE( 1 j  PJ*RHOS/D,  EQSTGM*RHOS*E ,  EQSTCM,  EQSTDM,  EQSTSM, 
1  EQSTGM , EQSTHM , EQSTEM , RHOS , EQSTNM , E , EQSTVM , EQST AM , NCYC ) 

RW=  AMAX1  ( 0 .  ,  1.  -  D/PTH) 

H  =  5R  M 
GO  TO  1860 

1855  H»5R  S  $  RVV>0, 

1860  IF  (PEL  .LT.  0.)  GO  TO  1500 

**  ENDING  ROUTINE.  * 

IF  (H  .EQ.  5R  M  .OR.  H  . EQ .  5R  S)  GO  TO  1905 
1900  DPDDJ  =  DPDEJ  =  0 . 

1905  P=PJ 

PST1 =PST  S  ASTI *ALFS 
RETURN 

C  FRAGMENTATION. 

2000  P  =  PST 1 =TJ=0 . 

RW  =  -ABS(RVV) 

ASTI  =  1  ,/(1  .  +RW ) 

H  =  5R  Z 
RETURN 

2300  FORMAT ( *  D, BULK, MUM, C, F, ELK, ELG, RH0P1 , E“* 1 P9E1 0 . 3 ) 

2349  FORMAT ( *  ITERATION  FAI LURE, M  =  * I  2, *  P=*1PE10.3,*  DV  =  *1PE10.3, 

1  *  DELVA  =  *1PE10.3, *  DELVB  =  *  1  PE 1 0 . 3 ) 

END 


PEST 

901 

PEST 

902 

PEST 

903 

PEST 

904 

PEST 

905 

PEST 

906 

PEST 

907 

PEST 

906 

PEST 

909 

PEST 

91  0 

PEST 

91  1 

PEST 

912 

PEST 

913 

PEST 

914 

PEST 

915 

PEST 

916 

PEST 

917 

PEST 

918 

PEST 

91  9 

PEST 

920 

PEST 

921 

PEST 

922 

PEST 

923 

PEST 

924 

PEST 

925 

PEST 

926 

9/12/79 

16 

PEST 

928 

PEST 

929 

PEST 

930 
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SUBROUTINE  POREQST 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINE  POREQST ( NC ALL  , 1 N, M , C , D , DOLD , E ,EOLD ,E , P , C Z J , CW J , H , DPDE ,  POREQST 2 
1  EQSTCM,EQSTDM,EQSTGM,EQSTSM,MUM,RH0SM,YADDM,NDSM,NPRM, J)  POREQST  3 

POHEQST  4 

ROUTINE  READS  INPUT  DATA  FOR  POROUS  MATERIAL  AND  COMPUTES  PRESSUREPOREQST5 

POREQST  6 

READ  INPUT  (NCALL=0).  CALL  IS  FROM  GENRAT  POREQST7 

INPUT  -  NC  ALL  *  IN.  M,  MATERIAL  PROPERTY  CARDS  POREQST  8 

OUTPUT  -  ORGANIZES  DATA  AND  FILLS  AK .  MUP.  PORA.  RHOP.  YaDDP  POREQST 9 

PREPARE-  D  =  RHOP(M.l).  CZJ  =  CZQ(M)  =  C0SQ(M,6)  POREQMO 

YADDM  =  Y0(M)»  CWJ  =  CWQ(M)  a  Cl ( M , 6 )  POREQS11 

C  a  EXMAT ( M » 3 )  =  SOUND  SPEED  POREQS 1 2 

COMPUTE  PRESSURE  ( NCALL= 1 )  POREQS 1 3 

INPUT  -  NCALL.M.C.D.DOLD.E.EOLD.F . P=POLD .H . EQSTCM . EQSTGM . RHOSM . POREQS 14 


NDSM.NPRM 

OUTPUT  -  C,P,H»CZJ,CWJ,DPDE,MUM,YADDM 

NOTE  CHANGE  IN  INPUT  SO  THAT  FIRST  VALUE  OF  P2  IS  YIELD  AND 
PERTAINS  TO  D  ,LE.  RH0PIM.2) 

REAL  MUM, MUP 
INTEGER  H 

COMMON  /POR/  AK (6) ,MUP (6) ,NREG (6) , PORA (6,5) ,PORB (6,5) ,PORC (6,5) 
1  RH0PI6.6) ,YADDP(6.5) 

DIMENSION  C  OSQ  (  6  *  6 ) *  C 1 (6*6) .TEMP (6) 

DATA  NAT,NBT,NCT,NDT,NET,NFT/10H  -POREQST- . 1  OH ,  ,G/CM3  , 

1  1  OH , G/CM3  ,10H.DYN/CM2*  =  .10H.DYN-CM/G  ,10H,=  / 

IF  ( NC ALL  .EQ.  1)  GO  TO  200 

«***  READ  INPUT  DATA  FOR  POROUS  MATERIAL  ***« 

READ  (IN, 1192)  A1 ,AK (M) ,A2,MUP (M) ,A3,YZER0 

PRINT  1130*A1 ,AK (M) ,A2,MUP(M) , A3 . YZERO , I N , NAT , NOT , NFT 

READ  (IN, 1100)  Al.NREG(M) 

C  1  . 


WRITE 

(6*1 

100) 

A1,NREG(M) 

WRITE ( 

6*11 

10)  I 

N.NAT, 

NtJT 

READ  ( 

IN  *  1 

120) 

A  1  * (RHOP (M 

*1)  * 

I 

=  1  * 

6) 

PRINT 

1131 

*  A  1 1  ( 

RHOP (M 

*D  * 

1  =  1* 

6 

)  *1 

N, 

NATtNCT 

DO  50 

1  = 

1*6 

C  0  SQ  (  M 

*  I ) 

=  4.0 

50 

Cl (M,  I 

)  = 

0.15 

55 

READ  ( 

IN*  1 

005)  ( 

TEMP ( I 

)  *1  = 

1*8) 

DECODE 

(3* 

1125* 

TEMP) 

A  1  ,  A2 

IF  ( A 1 

.EQ 

.  1HC 

.AND. 

(  A2 

.EQ 

. 

1  HO 

.OR. 

A2 

IF  ( A 1 

.EQ 

.  1HC 

.AND. 

A2 

.EQ. 

1H1 

) 

60  TO 

62 

GO  TO 

65 

60 

DECODE 

(80 

*1120 

.TEMP) 

Al* 

(COSQ 

(M, 

I) 

*1  =  1* 

6) 

PRINT 

1131 

*  A 1  ,  ( 

COSQ (M 

*1)  * 

1  =  1  * 

6 

>  *  IN t 

NAT 

GO  TO 

55 

62 

DECODE 

(80 

*1120 

, TEMP ) 

Al  * 

(Cl  ( 

M 

♦  I) 

*1 

=  1*6) 

PRINT 

1131 

*  A 1  *  ( 

Cl  (  M ,  I 

)  *1  = 

1*6) 

* 

IN* 

NAT 

GO  TO 

55 

65 

CZJ  = 

CO  SQ 

(M,6) 

a. 

CWJ 

=  C 

1 

(  M  9 

6) 

.EQ.  1HO ) )  GO  TO  60 


=PORC (M, 1 ) =0 . 


no 


NP=NREG(M)  $  P1=0. 

DECODE  (80. 1192, TEMP)  A1»P1 
PRINT  1 132, A1 ,Pl . IN, NAT, NOT 
PORA(M,l)=Pl  $  PORB(M.l) 

YADDP(M,D=C. 

DO  110  N  =  1 , NP 

READ  (IN, 1192)  A1 ,P2,A2,DELP*A3, YADDP (M,N) 

PRINT  1130,A1 ,P2,A2,DELP, A3, YADDP (M,N) , I N ,NAT ,NOT , NET 
DRHOaRHOP (M,N*1 ) -RHOP (M,N) 

PORA (M,N*1 ) rPl*RHOP(M,Nn ) /DRHO"  ( P2-P 1 -4 . *DELP*RHOP ( M , N ) /DRHO) 

PORB ( M , N* 1 ) =-RHOP ( M,N*1 ) "RHOP (M,N) /DRHO* ( P2-P 1 -4 . "DELP* ( RHOP ( M , N* 1 P0REQS66 
1  ) *RH0P (M,N) ) /DRHO)  P0REQS67 

PORC ( M , N* 1 ) =-4."DELP" (RHOP ( M » N* 1 ) "RHOP ( M , N ) /DRHO ) *"2  P0REQS68 

P 1 =P2  P0REQS69 


P0REQS15 
POREQS 1 6 
POREQS  1 7 
POREQS 1 6 
POREQS 19 
POREQS20 
P0REQS21 
P0REQS22 
POREQS23 
P0REQS24 
P0REQS25 
P0REQS26 
P0RFQS27 
POREQS2B 
P0REQS29 
POREQS30 
POREQS3 1 
P0REQS32 
P0REQS33 
P0HEQS34 
P0REQS35 
P0REQS36 
P0REQS37 
POREQS38 
P0REQ539 
PURfc'QS^O 
P0RLQS41 
P0KEQS42 
P0REQS43 
P0REQS44 
P0REQS45 
P0REQS46 
POREQS4  7 
POREQS'.b 
P0REQS49 
POREUS50 
P0REQS51 
P0REQS52 
P0REQS53 
POREQS54 
POREQS55 
PUHEQS56 
P0REQS57 
P0RLQSS6 
P0REQS59 
POREQS60 
P0REQS61 
P0REQS62 
P0REQS63 
P0REQS64 
P0REQS65 
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SUBROUTINE  POREQST  (Concluded) 


170  YADDM  *  YZERO 

C  *  SORT ( (  AK(M)  ♦  1,333  *  MUP(M))/D) 
190  RETURN 


•  ****  CALCULATION  OF  PRESSURE  IN  A  POROUS  MATERIAL  **** 


200  TF*1,*E*EQSTGM*RH0SM/EQSTCM  S  DREF*D*TF  $  NC*5 
C  FIND  APPROPRIATE  DENSITY  REGION  OF  POROUS  RELATIONS 

IF  (DREF  ,GT.  RH0P(M,6>)  GO  TO  280 
P2  *  0, 

IF  (DREF  ,GT.  RH0P(M,5)  .OR,  H  «EQ.  5R  Q)  GO  TO  222 
NC  =  0 

205  NC*NC*  1 

IF  (DREF  ,GT,  RHOP(M,NO)  GO  TO  205 

P2*F* (PORA (M, NC) *PORB (M,NC) /DREF+PORC (M,NC) /DREF**2> 

IF  (DREF  ,LT.  RHOSM)  GO  TO  230 
C  CHECK  FOR  CONSOLIDATION  IN  LAST  POROUS  REGION 

222  CALL  EQST (E?D»PS»M,CJ»A1»A2) 

IF  (H  . EQ.  5R  Q>  GO  TO  225 
IF  (PS  . LT.  P2)  GO  TO  230 
225  P*PS  $  Hs5R  0  $  NC*5  S  RETURN 

C  COMPUTE  PRESSURE  ON  INTERMEDIATE  SURFACE 

230  RHOM*RHOP(M,l)/TF  $  RHOP V*F* ( RHOP ( M , 5 > -RHOSM ) ♦RHOSM/TF 

RATIOsAMINl ( 1 . , (RHOM-D) / (RHOM-RHOPV) *RH0PV/O* ( 1 , - ( RHOPV-D ) / 
1  (RHOPV-RHOM) *RHOM/D) ) 

BULK=F* ( AK (M)  ♦ (EQSTCM-AK ( M) ) *RATIO) 


POREQS70 
P0REQS7 1 
POREQS72 
P0REQS73 
P0REQS74 
POREQS75 
POREQS76 
POREQS77 
POREQS78 
POREQS79 
POREUSbO 
P0RE0S81 
P0REQS82 
P0REQS83 
P0REQS84 
P0REQS85 
P0REQS86 
P0REQS87 
P0REQS88 
P0REQS89 
POREQS90 
P0REQS9 1 
P0REQS92 
POREQS93 
POREQS94 
P0REQS95 


250 


C 

270 


C 

280 

1100 

1005 

1110 

1120 

1125 

1130 

1131 

1132 
1192 


MUM*F*MUP ( M ) ♦ (MUM-MUP (M) *F) *RATIO 

PBULK*P*BULK* ( (D-OOLD) / ( .5* (D+DOLD) ) *EQSTGM*RHOSM/EQSTCM* ( E-EOLD ) 
CHECK  WHETHER  STATE  POINT  IS  ON  INTERMEDIATE  OR  YIELD  SURFACE 
P*P2  S  IF  ( PBULK  ,GT.  P2>  GO  TO  250 
P*PBULK  $  IF  (DREF  ,GT.  RHOSM)  PaAMAXl (PBULK, PS) 

COMPUTE  SOUND  SPEED 
CSQ  * ( BULK  ♦ 1 . 333  *MUM)/D 
IF  (CSQ  , LT.  0.)  GO  TO  270 

CQ«CSQ+C**2  $  C*CSQ*C/CQ  ♦  0.25*CQ/C  $  DPDE=0. 

COMPUTE  ARTIFICIAL  VISCOSITY  COEFFICIENTS 
RATIOsO. 

DELR*RHOP ( M » NC ♦ 1 ) -RHOP (M, NC) 

IF  (DELR  ,NE.  0.)  RATIO* ( DREF-RHOP ( M»NC) )/DELR 
CZJ*COSQ(M,NC) ♦ (C0SQ(M,NC*1)-C0SQ(M*NC) )*RATIO 
CWJ*C1 (M»NC) ♦ (Cl (M.NC+l ) -Cl (M,NC) )*RATIO 
IF  (NC  . LE .  NREG(M))  Y ADOM* Y ADDP ( M , NC ) 

RETURN 

COMPUTE  PRESSURE  IN  CONSOLIDATED  MATERIAL 
H*5R  S 

call  eqst (E*o,p,m,c,opdo,dpde> 

FORMAT (A10* 110* Al0tlPE10.3) 

FORMAT  (8A10) 

FORMAT (1H*»79X»7H  IND*  ,5H,  IN*,I2,4A10) 

FORMAT (A10*7E10.3> 

FORMAT  ( 1 X , 2A 1 ) 

FORMAT (3(A10*lPE10.3) *20X»7H  IND*  *5H,  IN*,I2»3A10) 

FORMAT (A10*lP6El0»3*l0X*7H  IND*  »5H,  IN*,I2»3A10) 


FORMAT(A10*1PE10.3*60X,12H  IND* 
FORMAT (4 (A10«El0,3) ) 

RETURN 

END 


,  IN** 1 2 , 3  A 1 0 ) 


) POREQS97 
P0REQS98 
P0REQS99 
POREQ100 
POREQ 1 0 1 
P0REQ102 
POREQ 1 03 
POREQl 04 
POREQl 05 
POREQ106 
POREQ107 
POREQ  108 
POREQl 09 
POREQ 110 
POREQl 1 1 
POREQl 12 
POREQl 1 3 
POREQ 114 
P0REQ115 
POREQl 16 
POREQl 17 
POREQl 18 
POREQl 19 
POREQ120 
P0REQ121 
P0REQ122 
P0REQ123 
P0REQ124 
P0REQ125 
P0REQ126 
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SUBROUTINE  PORHOLT 


C 

c 

c 

c 


150 

C 

C 

C 

C 

200 


C 

C 

C 


250 

C 

255 


SUBROUTINE  PORHOLT ( NPART , I N ♦ M , C ♦ DH , DOLO , EH , E OLD 9 F , P , 1 H , J , DPDEJ , 

1  EQSTCMf MUM  9 Y ADDM ♦ RHOS » DT ) 

BASIC  EQUATIONS  OF  THIS  MODEL  ARE  BY  AL  HOLT  OF  LLL  • 

REAL  MUM  9  MUP 

DIMENSION  RHO (6)  9 RHOC (6)  » ALF0(6)  .  AK (6)  9  MUP (6)  9  YADDP (6)  »PY (6) 

1  Y  0 ( 6 )  9  ALF (300)  9  A (6)  9B<6)  9 RHOE (6)  9 RHOES (6)  9TPH(6) 

IF  (NPART  •  EQ  •  1)  00  TO  200 


***** 


READ  AND  INITIALIZE 


***** 


1 


READ  IN  SPECIAL  PROPERTIES  FOR  POROUS  MATERIAL 
WRITE  (6,1010) 

WRITE  (6,1011) 

READ  (IN, 1001) 

WRITE  (6,1001) 

READ  (IN, 1001) 

WRITE  (6,1001) 

READ  (IN,  100i: 

WRITE  (6,1001) 

INITIALIZE 
YADDM  =  YO ( M ) 

DH=RHO(M)  $  C=SQRT ( ( AK (M) ♦ 1 ,333*MUP (M) ) /DH) 

INITIALIZE  VARIABLES  FOR  PORHOLT 
ALFO (M) =RHOS/RHO ( M ) 

RHOE (M) =RHO (M) * (PY (M) /AK (M) *1 . ) 

RHOES(M) =RHOS* (PY (M) /EOSTCM+1 . ) 

ALFE  =  RHOES (M) /RHOE  <M) 

A (M) =ALFE* ( ALFE*RHOE (M)/EG)STCM*DPDRHO- (RHOES (M)-RHOS) /RHOS) 

B (M) = (RHOC (M) -RHOES (M) ) / (RHOC (M) -RHOE (M) ) **?- A ( M ) / ( RHOC ( M ) -RHOE 
M)  ) 

,B(M) ,RHOES(M) ,RHOE(M) 


A 1 , RHO ( M ) , A2 , RHOC ( M )  , AJ,TPH (M) ,A4»PY (M) 
Al*RHO(M) , A2 , RHOC ( M ) *A3»TPH(M) ,A4,PY(M) 
A1 , AK (M) , A2 , MUP ( M ) , A3, YO (M) ,A4, YADDP (M) 
A 1 , AK ( M ) ,A2,MUP(M)  ,A3.Y0(M) , A4, YADDP (M) 
I  Al*DPDRHO 
i  A 1  *  DPDRHO 

YIELD  AND  DENSITY  FOR  6ENRAT 


1002, A (M) 

(6,1010) 


PRINT 
WRITE 
C  J  e  1  • 

DO  150  1=1*300 
ALF ( I ) =0  • 
RETURN 


***** 


COMPUTE  pressure 


alf 


1 


1 


INITIALIZE 
CONTINUE 

IF  (ALF(J)  .EU.  0.)  ALF (J)=ALFO(M) 

IF  (ALF(J)  ,LE,  1.)  GO  TO  300 

COMPUTE  ELASTIC  VALUE  OF  ALF  ON  UNLOAD  OR  RELOAD  CURVES 
AAKC= (CURRENT  BULK  MODULUS )/( BULK  MODULUS  OF  SOLID) 

AAKC=AK (M) *(ALFO (M)-l , ) / (AK ( M ) * ( ALFO ( M ) - 1 . ) ♦ (EUSTCM-ALFO(M) * 

AK (M) ) * ( 1 .-l./ALF ( J) ) ) /ALF ( J) 

ALFE  =  ALF ( J) * ( DOLD/RHOS-P/EQSTCM ) / ( DH/RHOS-P/EOSTCM-A AKC* ( DH-DOLO : 
RHO (M) ) 

IF  (DH  ,LT,  DOLD)  GO  TO  250 

COMPUTE  STATIC  VALUE  OF  ALF  ON  THE 
ALFSs (RHOES (M) ♦ (A (M) *B ( M ) * ( DH-RHOE ( M ) 

CHECK  WHETHER  FLOW  STRESS  HAS  BEEN 
IF  (ALPS  .GT.  ALFE)  GO  TO  250 
COMPUTE  DYNAMIC  VALUE  OF  ALF 
ALF(J)=AMAX1 (1,, (ALFS+TPH(M)*ALFE/DT)/(1,*TPH(M)/DT) ) 

GO  TO  255 
ALF ( J) =ALFE 

COMPUTE  DENSITY  IN  THE  SOLID 
DS=ALF ( J) *DH 
POLD=P 

COMPUTE  PRESSURE  IN  THE  SOLID  MATERIAL 

call  eqst <eh,ds,ps,m, cj, dpdejj 

COMPUTE  GROSS  PRESSURE 
P=PS/ALF ( J) 


flow  curve 

I ) * (DH-RHOE  (M) ) ) 
REACHED  DURING 


/DH 

LOADING 


PORHOLT  2 
PORHOlT  3 
P0RH0LT4 
PORHOL  15 
PORHOLT  6 
PORHOLT7 
, PORHOLT  8 
P0RH0LT9 

porholio 
PORHOL 1 1 
PORHOL 12 
PORHOL 1 3 
PORHOL 1 4 
PORHOL 1 5 
PORHOL 1 6 
PORHOL 1 7 
PORHOL 18 
PORHOL  1  9 
PORHOL20 
P0RH0L21 
P0RH0L22 
P0KH0L23 
P0RH0L24 
P0RH0L25 
P0RH0L26 
P0RH0L27 
P0RH0L26 
P0KH0L29 
PORHOL30 
PORhOL  3 1 
P0RH0L32 
PORHOL33 
PORhOl  34 
PORHOL35 
P0RH0L36 
P0RH0L37 
P0RH0L38 
PORHOL  39 
P0RH0L4  0 
P0RH0L41 
P0RH0L42 
PORHOL A3 
PORHOL A4 
P0RH0I.45 
P0RH0LA6 
PORHOL47 
PORHOL A8 
P0RH0L49 
PORHOL50 
P0RH0L5 1 
/P0RH0L52 
PORHOL  53 
P0RH0L54 
PORHOL55 
P0RH0L56 
P0RH0L57 
P0RH0L58 
P0RH0L59 
PORHOL60 
P0RH0L61 
P0RH0L62 
PORHOL63 
P0RH0L64 
P0RH0L65 
P0RH0L66 
P0RH0L67 
P0RH0L6B 
P0RH0L69 
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SUBROUTINE  PORHOLT  (Concluded) 

MUM=< (ALFO (M) -ALF (M) )*MUM*(ALF(J)-1.)*MUP(M) )/<ALFO(M)-l.) 
YADDMsYADDP  <M) 

CSQ* ( AAKC*EQSTCM*1 .333*MUM) /DH 
IF  (CSQ  .LT.  1.E6)  GO  TO  270 
C=SQRT (CSQ) 

270  RETURN 

*****  PRESSURE  IN  CONSOLIDATED  MATERIAL  ***** 

300  I H*5R  S 

CALL  EQST(EHfDH,PfMfC*DPDEJ) 

RETURN 

1001  FORMAT (4 (A10* 1PE10.3) ) 

1002  FORMAT ( *  Ai Bi RHOESf RHOE  =*1P4E13.4> 

1010  FORMAT ( / ) 

1011  FORMAT ( *  READ  IN  PORHOLT*) 

END 


PORHOL70 
P0RH0L71 
PORHOL72 
POHHOL  73 
POHH0L74 
PORHOL  75 
P0RH0L76 
PORHOL77 
PORHOL78 
PORHOL79 
PORHOL80 
P0RH0L81 
P0RH0L82 
PORHOL83 
P0RH0L84 
P0RH0L85 
P0RH0L8f> 
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SUBROUTINE  PRESCR 


C 


C 


c 

c 


c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


50 

60 


70 


1 

2 

3 

4 

5 
1 


1 


1 


1 

2 

1 


1 

2 

3 

1 

2 
3 


SUBROUTINE  PRESCR  PRESCR  2 

INTEGER  H,POROUS*PRESS*RINTER, SOLID, SPALL  PUFCOm  2 

REAL  MATL,NEM,NET,NEMH,NETH  PUFCOM  3 

MISCELLANEOUS  PUFCOM  4 

COMMON  AZERO ( 1 ) , CEF , CKS * D A VG , DEL T I M , D I SCPT ( 10 ) »OOLD ,DRHO ,DTMAX ,  PUFCOM  5 
DTMIN,DTN,DTNH,DU,DX,EOLDfF,FAC,FIRST, J , JC YCS , J I NI T ,  PUFCOM  6 

JFIN, JREZON ( 15)  , JSMaX , JST AR , JTS ,LSUB ( 30 )  ,M,MAXPR(30)  ,N,NCTCS,  PUFCOm  7 

NEDIT,NPERN,NR,NREZON,NSCRB(6)fNSEPHAT,NSPALL,NTEUT,  PUFCOM  8 

NTEX , NTR (15) *POLD*P6(20>  *  R ( 30 ) » RL AST , SL AST , SMAX , TED  I T ( 50 )  *  PUFCOM  9 

TF,T1ME,TJ,TREZ0N,TS,T6 (20 ) , UL AST » UOLD * UZERO , XL  AST » XNOW , XOLD  PUFCUMI 0 
»XJDIT (20)  PUF  COM 1  1 

HALFSTEP  VALUES  PUFCOMl 2 

COMMON  DH»DHLAST»DUH*EH,PH,RH,RHLAST,SH,SHLAST,UH,UHLAST»XH,XHLASTPUFCOm13 


, NEMH , NETH 

CONDITION  INDICATORS 

Common  inf ,l inter? mirror ♦ normal  * porous *  press *r inter, sol  id, spall 

CELL  LAYOUT 

COMMON  DXX ( 30 )  * JBNU ( 30 )  , JMA T (30)  ,NAUTO , M A TL ( 6 , 2 )  , NL A YER ,NM TRLS , 
THK ( 30 ) 


PUFC0M14 
PUFCOM lb 
PUF  CO  <'16 
PUF  COM 1 7 
PUFCOM 1 8 
PUFCOMl 9 

PUFCOM20 

COORDINATE  ARRAYS  C00RUC02 

COMMON/COORD/X (200) ,X0 (200 ) ,CHL (200) , DHL (200) ,DPDD (200) , DPDE (200) *CO0RDCO3 
EHLI200) *  H ( 20  0  *  3 )  ,NEM(200)  *  NET (200) tPHL(200) *RHL(200) *SDT<200) *  C0URUCU4 
SHL  (200)  »T (200) ,U(200) ,YHL(200) ,ZHL(200)  COORDCD5 

COMMON  /JED/JEDIT (100)  ,JNUM(100) ,JTYP  (100)  ,NAME2(40) ,JEDSIZ,  JEDCOM  2 

MODLUS,NERR,NJEDIT,NTAPE  JEOCOM  3 

COMMON/NSC/A ( 5000 )  NSCCOM  2 

DIMENSION  NN(20) tNAME (40) ,LA ( 1 )  PRESCR  7 

EQUIVALENCE  (LA, A)  PRESCR  8 

DATA  (Name ( I) *1  =  1 ,33)/3HX  ,3HX0  ,3HC  *  3HD  , 4HDPDD , 4HUPUE , 3HE  , PRESCR  9 
3HH 1  ,3HH2  ,3HH3  , 3HNEM , 3HNE T  *3 HP  ,3HR  ,3HSDT,3HSl  ,3HT  ,3HU  PRESCR10 
, 3H Y  ,3HZ  ,4HC0Mi , 4HC0M2 * 4HC0M3 , 4HCOM4 , 4HC0M5 ,5HS- 1NT , 3HS2  ,  PRESCRll 
3HS3  *  3H 1 MP ,  3HV  ,3HSD1 , 3HSD2 * 3HS03/  PRESCR 1 2 

DATA  (NAME2 ( 1 ) *1  =  1  * 33 ) / 1 RX , 2RX0  *  1 RC *  1 RD ,4RDPDD , 4RDPUE , 1  RE *2«Hl ,  PRESCR  13 

2RH2*2RH3,3RNEM, 3RNET , 1 RP, 1RR,3RSDT,2RS1 , 1RT,1RU,  PRESCR 1 A 


1RY, 1 RZ  » 4RC0M 1 *4RC0M2*4RC0M3*4RC0M4,4rC0M5,5RS“INT*2RS2,2RS3, 
3RIMP, 1RV»3RSD1,3RSD2,3RSD3/ 

JK  FIRST  CARD  OF  A  (  1 0 0 ♦  )  TO  BE  READ  FROM 
JF  FIRST  WORD  OF  A (  )  TO  BE  READ  INTO 
KB*KE  BEGINNING  AND  ENDING  VALUE  J  FOR  GROUP 
JE  COUNTER  FOR  JED1TS 
JF1RST  FIRST  JED1T  OF  A  GROUP 

JTL AST  INDICATOR  THAT  THE  PREVIOUS  GROUP  WAS  ALPHA  (=0)  OR 
INTEGER  (=1) 

K  CHARACTER  COUNTER 

JKMAX  NUMBER  OF  CHARACTERS  USED  AT  A  TIME 
NCARD  NUMBER  OF  RECORDS  DECODED 
IW  COUNTER  FOR  ALPHA  GROUPS 
K  COUNTER  FOR  CHARACTERS  ON  A  CARD 

kp  period  indicator 

JTYP (  )  TITLE  ARRAY  FOR  HEADINGS  IN  SCRIBE 

JNUMCI  )  LOCATION  IN  ARRAY  COMMON 
JED1T (  )  J ( CELL  OR  COORDINATE)  NUMBER 
NJD=1ABS (NJED1T) 

IF  (NJEDIT  ,LT.  0)  NJD= (-NJEDIT-1 ) /14*1 
JK  =  l 

NLAY1=NLAYER*1 
DO  50  I=1*NLAY1 
JED  I T ( 1 ) = I 
JTYP(1)=5HS-1NT 
JNUM (  1 ) =50  0  0 
NLL  =  0 

IF  ( H ( 1 , 2 )  .EQ.  SPALL)  GO  TO  70 

nll=nll*i 

JED  I T ( NL AYER ) =0 

IF  (  H  ( JF  I N ,  2  )  .EG).  SPALL)  GO  TO  75 
JED  IT (NLAYER  +  NLL) =NLAYER 
NLL=NLL*1 


PRESCR 1 5 
PRESCR 1 6 
PRESCR 1 7 
PRESCR 1 8 
PRESCRl 9 
PRESCR20 
PRESCR21 
PRESCR22 
PRESCR23 
PRESCR24 
PRESCR25 
PRESCR26 
PRESCR27 
PRESCR28 
PRESCR29 
PRESCR30 
PRESCR31 
PRESCH32 
PRESCR33 
PRESCR34 
PRESCR35 
PRESCR36 
PRESCR37 
PRESCR38 
PRESCR39 
PRESCR40 
PRESCR41 
PRESCR42 
PRESCR43 
PRESCR44 
PRESCR45 
PRESCR46 
PRESCR47 


287 


SUBROUTINE  PRESCR  (Continued) 


75 

JE*NLA YER*NLL 

PRESCR48 

JFIRST=NLAYER*NLL 

PRESCR49 

JTLASTxO 

PHESCR50 

ab*ih 

PRESCR51 

NCARDsO 

PHESCP52 

K  =  i 

PRESCR53 

KB*  1 

PRESCR54 

JKMAX*70 

PRESCR55 

JF  =  i 

PHESCR56 

IW  =  1 

PRESCR57 

C 

PRESCR58 

C 

SELECT  A  GROUP  OF  CHARACTERS 

PRESCR59 

80 

DECODE  (80*1024, A(4000*JK) ) ( A (L> ,L*JF » JKMAX) 

PRESCR60 

JFlsJF-1 

PHESCRfcl 

JKl*4000*JK-l 

PRESCR62 

KP*o 

PHESCR63 

NCARD=NCARD*1 

PRESCR64 

100 

IF  (K  .GT.  JKMAX)  GO  TO  300 

PRESCR65 

IF  (LA (K)  .EQ.  1H  )  GO  TO  150 

PRESCR66 

IF  ((LACK)  .GE.  1  HA  .AND.  LA(K>  .LE.  1HZ)  .OR. 

PRESCR67 

1  (LA  (K)  .GE.  1  HO  .AND.  LA ( K )  .LE.  1H9>)  GO  TO 

140 

PRESCM68 

IF  (LA  (K)  ,NE,  1H. )  GO  TO  150 

PRESCR69 

KP*k 

PRESCR70 

140 

K  =  K  ♦  1 

PRESCR  7 1 

IF  (K  ,GT.  JKMAX)  GO  TO  160 

PRESCR72 

GO  TO  100 

PRESCR73 

150 

IF  (KB  ,LT.  K)  GO  TO  160 

PRESCR74 

KB=KB* 1 

PRESCR75 

K  =  K*  1 

PRESCR76 

60  TO  100 

PRESCR  77 

160 

KEsK-1 

PRESCR78 

C 

PRESCR79 

C 

EXAMINE  A  GROUP  OF  CHARACTERS  FOR  TYPE 

PRESCR80 

NKrKE-KB* 1 

PRESCR81 

NNL=KP-KB 

PRESCR82 

JFR=KE 

PRESCR83 

IF  (KP  ,NE,  0)  GO  TO  220 

PRESCR84 

IF  (A (KB)  .GE.  lHA  .AND.  A  (KB)  .LE.  1HZ)  GO  TO 

180 

PHESCR85 

C 

INTEGER  DATA 

PRESCR86 

KN  =10-NK 

PRESCR87 

ENCODE (10* 1021 *A1) (AB*L*1 *KN) * ( A (L) *L*KB*KE) 

PRESCR88 

DECODE  ( 10 • 1020  *A1 )  JEDIT(JE) 

PRESCR89 

IF  (JE  .NE.  NLA YER  .OR.  IW  .NE.  1)  60  TO  175 

PRESCR90 

NN  ( IW)  «=2HSl 

PHESCR91 

IW*IW*1 

PHESCR92 

175 

JTLASTal 

PRESCR93 

JE= JE* 1 

PRESCR94 

60  TO  260 

PRESCR95 

C 

ALPHABETIC  DATA 

PRESCR96 

180 

IF  (JTLAST  ,EQ.  0)  60  TO  210 

PRESCR97 

C 

SET  TYPE  INDICATORS  FOR  ALL  JEDITS  OF  A  SET 

AFTER  THE  NEXT 

PRESCR98 

c 

ALPHA  6R0UP  HAS  OCCURRED 

PRESCR99 

JE*JE-1 

PRESC100 

ND  J*0 

PRESC101 

IW1*IW-1 

PRESC 102 

ND J»» ( JE-JF I RST* 1 ) 

PRESC103 

DO  205  1*1. IW1 

PRESC104 

c 

PRESC105 

c 

CHECK  LE6ITIMACY  OF  ALPHA  DATA 

PRESC106 

IF  ( (NN ( I )  .AND.  77777700000000000000B)  .Ed.  3LC0M )  60  TO  190 

PRESC107 

DO  185  IK*1 .33 

PRESC108 

IF  ( NN ( I )  .EQ.  NAME  ( IK ) )  60  TO  190 

PRESC 109 

185 

CONTINUE 

PRESC 110 

60  TO  205 

PRESC1 1 1 

190 

NDJ=JE-JFIRST*1*NDJ 

PRESCl 12 

DO  200  J*JFIRST,JE 

PRESC1 13 

JTYP(J*NDJ)*NN(I) 

PRESCl  14 

IF  (I  .EQ.  1)  60  TO  200 

PRESCl 15 

JEDIT ( J*NDJ) *JEDIT ( J) 

PRESCl 16 
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SUBROUTINE  PRESCR  (Continued) 


200 

CONTINUE 

PRESC1  1  7 

205 

CONTINUE 

PKESCl  IB 

JE=JFIRST=JE+NDJ*1 

PRESC1 19 

JTLAST=0 

PRESC120 

I  W  =  1 

PRESC 1 2 1 

C 

DECODE  THE  ALPHA  GROUP  OF  A  SET 

PRESCl 22 

210 

ENCOOE  (NKt 1021 *NN ( IW> ) ( A ( L ) » L=KB , KE ) 

PRESC 123 

I  W= I W ♦ 1 

PRESC 1 24 

GO  TO  260 

PRESC 1 25 

C 

JEOIT  LISTEO  AS  LAYER  ANO  FRACTION 

PRESC 1 26 

220 

NNL=KP-KB 

PRESCl 27 

JFR=KE-KP* 1 

PRESC 1 28 

KP] =KP-l 

PRESCl 29 

KN=l 0-NNL 

PRESC 1 30 

ENCOOE  (10*1021*A1) ( AB  *  L  =  1 » KN ) * (A(L) ,L=KB,KP1> 

PRESC131 

DECODE (10, 1020*A1)NL 

PRESCl 32 

ENCOOE  ( JFR,1021,A1)  (AIL)  ,L  =  KP,KE) 

PRESCl 33 

OECOOE ( 10  *1025, A1 )  FR 

PRESCl 34 

JEND= JBNO ( NL ) 

PRESC 1 35 

JBEG= 1 

PRESCl 36 

IF  (NL  ,GT.  1)  JBEG=JBND (NL-1 ) *1 

PRESC 137 

OIST=X (JBEG) +FR" (X (JENO) -X (JBEG) ) 

PRESC 1 38 

J= JREG 

PRESCl 39 

240 

J=J*1 

PRESC 1 40 

IF  (X(J)  ,LT.  O I  ST )  GO  TO  240 

PRESC 1 4 1 

JED  I T ( JE ) =  J- 1 

PRESC 1 42 

JE  = JE ♦  1 

PRESC143 

JTL AST=  1 

PRESC 1 44 

260 

CONTINUE 

PRESCl 45 

K=KB=K ♦ 1 

PRESCl 46 

KP  =  0 

PRESC 1 4  J 

GO  TO  100 

PRESC 1 48 

C 

PRESC 1 49 

C 

PREPARE  FOR  NEXT  CARO  OF  DATA 

PRESC 1 50 

300 

IF  (NCARO  ,GE.  NJD)  GO  TO  400 

PRESC 1 5 1 

JF  =  1 

PRESCl 52 

JK= 1 *8*NCARD 

PRESC 153 

JKMAX  =  7  0 

PRESCl 54 

KDIF=K-KB 

PRESC 1 55 

IF  (KB  .EQ.  K)  GO  TO  330 

PRESC 1 56 

KB  1 =KB~1 

PRESCl 57 

KDIFl=KOIF+l 

PRESC 1 58 

DO  320  KK= 1 , KDI F 1 

PRESC 1 59 

320 

A  (  KK ) = A ( KB1 +KK ) 

PRESC 160 

JF=1+KDIF1 

PRESC161 

JKMAX=70*KDIF*1 

PRtSC 1 62 

KB=1 

PRESC 1 63 

K*KB*KDIF+1 

PRESC 1 64 

GO  TO  80 

PRESCl 65 

330 

KB=K* 1 

PRESC 1 66 

GO  TO  80 

PRESC167 

400 

CONTINUE 

PRESC 1 68 

JE= JE- 1 

PRESC 169 

ndj=o 

PRESCl 70 

I  wl  =  IW-l 

PRESCl 7 1 

DO  420  I =1 , I W 1 

PRESCl 72 

NDJ=(JE-JFIRST+1)*(I-1) 

PRESCl 73 

DO  420  J=JFIRST , JE 

PRESC 174 

JTYP ( J  +  ND  J ) =NN ( I ) 

PRESC 1 75 

IF  (I  .EQ.  1)  GO  TO  420 

PRESC 1 76 

JEDIT (J+NDJ)= JEDIT (J) 

PRESC 1 77 

420 

CONTINUE 

PRESC l 78 

NJE0IT=JE*NDJ 

PRESCl 79 

C 

PRINT  ANO  PUNCH  JEDIT  VALUES 

PRESC180 

JFIRST=1 

PRESC181 

I ENOr 0 

PRESC182 

JTYPE  =  JT YP  ( 1 ) 

PRESCl 83 

DO  450  J  =  2 , N JED  I T 

PRESCl 84 
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SUBROUTINE  PRESCR  (Concluded) 


425 


427 

428 


429 


430 

435 


437 

439 

440 

445 


IF  (JTYP(J)  ,EQ.  JTYPE)  GO  TO  445 
JEND=J-1 
JNUMB=10000 
J  A*0 

JB= ( JTYPE  .AND.  777777000000000000008) 
JC  = (JTYPE  .AND.  000000007700000000008) 
IF  ((JTYPE  .AND.  77777700 0 0 0 00 00 0 0 00 OB ) 
IF  ((JTYPE  .AND.  000000007700000000008) 
1  427 

DECODE (10.1 052. JTYPE) JA 
GO  TO  428 

DECODE (1 0,1 051, JTYPE ) JA 
JNUMR=3999*JA 
11=20 
GO  TO  435 
DO  430  1=1.33 

IF  (JTYPE  ,NE.  NAME ( I ) )  GO  TO  430 
JNUMB=200*(I-1> 

11  =  1 


PRtSCl 85 
PRESC 1 86 
PRESCl 87 
PRESC 1 88 
PRESC 1 89 
PRESC 1 9o 

NE.  3LCOM)  GO  TO  429  PRESC191 
EQ.  550000000000B)  GO  TO  PRESC1 92 

PRESC 1 93 
PRESCl 94 
PRESC 1 95 
PRESC 1 9b 
PRESC | 97 
PRESC] 98 
PRESCl 99 
PRESC200 
PRESC20  1 
PHESC202 
PRESC203 
PRESC/04 
PRESC?05 
PRESC?  06 
PRESC207 
PHESC208 
PRESC209 
PHESC2 1 0 
PRESC21 1 
PRESCP 1 2 
PRESC213 
PRESC214 
PRESC215 
PRESC21 6 
PRESC217 
PRESCP18 
PRESC219 
PRESC220 
PRESC22 1 


GO  TO  435 
CONTINUE 
CONTINUE 

DO  440  1=JFIRST. JEND 
IF  (11  •  EQ  •  20)  GO  TO  439 
IFII1  .EQ.  25)  GO  TO  437 

ENCODE(10»1430»JTYP(I) ) NAME2 (II) .JEDIT(l) 

GO  TO  440 
11=1*1 

ENCODE(10*1431»JTYP(I) )NAME2(25>  .I.Il 
GO  TO  440 

encode (i o.i 432. jtyp(I) > ja.jeditcd 

JNUM ( I ) * JNUMB 
JFIRST=J 
JTYPE= JTYP (J) 

CONTINUE 

IF  (J  ,LT .  NJEDIT  .OR.  IEND  ,EU.  1)  GO  TO  450 
JEND=NJEDIT 


IEND*1 

JTYPE® JTYP ( J ) 

GO  TO  425 
450  CONTINUE 

PRINT  1450. (JTYP ( 1 ) .1=1. NJEDIT) 
RETURN 

1020  FORMAT  (110) 

1021  FORMAT  (80A1) 

1024  FORMAT  (10X.70A1) 

1025  FORMAT  (F10.6) 

1051  FORMATOX.I1.6X) 

1052  FORMAT (3X.I2.5X) 

1430  FORMAT (R5,1H(,I3,1H)  ) 

1431  FORMAT(R5.1H(,Ii,lH,U,lH)  ) 

1432  FORMAT (3HC0M.I2,1H( »I3»1H)  ) 

1450  FORMAT  (/*  OUTPUT  FROM  PRESCR*/ ( 
END 


PRESC222 

PRESC223 

PRESC224 

PRESC225 

PRESC226 

PRESC227 

PRESC228 

PRESC229 

PRESC230 

PRESC231 

PRESC232 

PRESC233 

PRESC234 

PRESC2J5 

PRESC236 

.  1 2 ( A 1 0 ) ) )  PRESC237 

PRESC238 
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SUBROUTINE  REBAR 


SUBROUTINE  REBAR (LL, I N , JC , I C , M , N , IHJDHJDOLDJSXJSYJSZJTXVJEJPJ  REBAR 

1  DEX, DEV, DEZ, DEXY , F , THETA , DTHETA , ESC, FS, DSTL, SRS,  REBAR 

2  ZEVP, TEVP, Y,R0LD, IPRINT)  REBAR 

C  SRI  AND  SR3  ARE  OLD  AND  NEW  STRESSES  ON  STEEL.  REBAR 

C  SR2  AND  SR4  ARE  OLD  AND  NEW  STRESSES  ON  CONCRETE.  REBAR 

C  ALL  STRESSES  ARE  DEVIATORS  EXCEPT  SRS  ARRAY  REBAR 

C  STRESSES  ARE  POSITIVE  IN  TENSION,  PRESSURE  IS  POSITIVE  IN  COMP.  REBAR 

C  STRAINS  ARE  POSITIVE  IN  TENSION  REBAR 

C  PLANE  OF  REBARS  IS  INITIALLY  NORMAL  TO  THE  X  DIRECTION  REBAR 

C  THETA  IS  OLD  VALUE  OF  ROTATION  ANGLE,  POSITIVE  TOWARDS  Y  REBAR 

C  DTHETA  IS  INCREMENT  OF  THETA  ON  CURRENT  CYCLE  REBAR 

DIMENSION  SRC  4) ,SRS(4) ,SR1  (4) ,SR2(4) , DEC ( 4 ) , DESC4) , DE ( 4 ) ,SR3(4) ,  REBAR 

1  SR4C4) , THETC6) ,  I MC ( 6 ) ,  I  MS ( 6 ) , FSTEEL ( 6 ) , ESC (6, 20)  REBAR 

IF  (LL  .GE.  0)  GO  TO  15  REBAR 

READ  1 004 , A 1 , FSTEEL ( M ), A2 , THET ( M ), A3 , IMC(M),A4, IMS(M)  REBAR 

PRINT  1 004 , A1 , FSTEEL CM) , A2, THET  CM), A3,  I MC  CM), A4 ,  IMSCM)  REBAR 

1004  FORMAT (A10, E10.3,A10, E10. 3, A10,  I  10, A 10,  I  10)  REBAR 

LS=0  REBAR 

MC=IMCCM)  REBAR 

MS  = I  MS ( M )  REBAR 

SX=SQRT ( (FSTEEL CM) *( ESC (MS, 2)+1 . 33* ESC (MS, 5) )+( 1 . -FSTEEL ( M ) ) *  REBAR 

1  ( ESC ( MC , 2 ) + 1 . 33*ESC (MC, 5) ) )/( FSTEEL ( M ) *ESC ( MS, 1 )+( 1 . -FSTEEL (M) ) *  REBAR 

2  ESC ( MC , 1 ) ) )  REBAR 

DH  =  FSTEEL ( M ) *ESC ( MS,  1  )  +  (1  .  -FSTEEL ( M )) *ESC ( MC,  1  )  REBAR 

Y  =  ESC ( MS ,  10)  REBAR 

RETURN  REBAR 

15  I F (  ROLD  .NE.  0.)  GO  TO  18  REBAR 

MC= I MC ( M )  REBAR 

MS= I  MS ( M )  REBAR 

FS=FSTEEL(M)  REBAR 

THETA  =  THET ( M )  REBAR 

DSTL=ESC ( MS, 1 )  REBAR 

ROLD=ESC ( MC , 1 )  REBAR 

18  CONTINUE  REBAR 

MC= I MC ( M )  $  MS= I  MS ( M )  REBAR 

NTRY  =  1  REBAR 

RHOS=ESC ( MC , 7)  REBAR 

EQSTC=ESC(MC, 2)  REBAR 

GRUN=ESC(MC, 9)  REBAR 

AMU=ESC(MC, 5)  REBAR 

CR I T= 1 . E7  REBAR 

TEVPSV=TEVP  REBAR 

ZEVPSV=ZEVP  REBAR 

YSV= Y  REBAR 

I HSV  = I H  REBAR 

I  PR I NT  =  0  REBAR 

FS1 =FS= ( DOLD-R0LD ) / ( DSTL -ROLD )  REBAR 

C0S2TH=C0S ( 2 . #THETA )  REBAR 

S I N2TH=S I N ( 2 . *THETA )  REBAR 

C  ROTATE  STRAIN  INCREMENTS  TO  AXIS  OF  REBARS  REBAR 

SI N2TH1 =SIN2TH+DTHETA*C0S2TH  $  COS2TH1 =C0S2TH -S I N2TH# DTHETA  REBAR 

DEC  1  )  =  ( DEX+DEY+ ( DEX-DEY ) *C0S2TH 1  ) /2 . +DEXY#S I N2TH1  REBAR 

DE ( 2 ) = ( DEX+DEY - ( DEX-DEY ) *C0S2TH 1 ) /2 . -DEXY*S I N2TH1  REBAR 

DE ( 3 ) =DEZ  REBAR 

DE (4 ) = - ( DEX-DEY ) *SI N2TH1 /2. +DEXY*C0S2TH 1  REBAR 

C  ROTATE  STRESSES  TO  AXIS  OF  REBARS  REBAR 

SRC  1  )  =(SX+SY+( SX-SY) *C0S2TH)/2. +TXY*SI N2TH  REBAR 

SRC  2) ■ C SX+SY- ( SX-SY ) #C0S2TH ) /2 .  -TXY*SI N2TH  REBAR 

SR ( 3 ) =SZ  REBAR 

SRC  4)  =  - (SX-SY) *SI N2TH/2 . +TXY  *C0S2TH  REBAR 

RL  =  0 .  $  RR  = 1  .  REBAR 

IF  (IPRINT  .EG.  1)  PRINT  1 1 20, ( SR ( I ) , I = 1 , 4 ) , SX , SY , SZ , TXY , C0S2TH ,  REBAR 
1  SIN2TH  REBAR 

*******  ###########  REBAR 

BEGINNING  OF  COMPUTATIONAL  LOOP  FOR  EACH  STRAIN  INCREMENT  REBAR 

120  PS=PS1 = - ( SRS ( 1 )+SRS(2)+SRS(3) )/3.  REBAR 

FS  =  FS1  REBAR 

PC=PC1 =(P-PS1 *FS)/( 1 . -FS)  REBAR 

DO  170  1=1,4  REBAR 

SRI ( I ) =SRS ( I )+PS1  REBAR 

IF  (I  .EG.  4)  SRI (4)=SRS(4)  REBAR 

SR2 ( I )  =  (SRC  I  ) -SRI ( I  ) *FS)/( 1  . -FS)  REBAR 

170  DEC ( I ) =DES ( I ) =DE ( I ) *RR  REBAR 

DES ( 1 ) =DEC ( 1 ) *ESC(MC, 2) /ESC (MS, 2)  REBAR 

DEC ( 1 ) = ( DE ( 1 ) #RR-DES ( 1 )*FS)/(1 . -FS)  REBAR 


2 

3 

4 

5 

6 

7 

8 
9 

10 
1  1 
12 
1  3 

14 

15 
1  6 
17 
1  8 
1  9 
20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 
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SUBROUTINE  REBAR  (Continued) 


1  80 

NC  =  0 

REBAR 

77 

o  *******  *********** 

REBAR 

78 

c 

BEGINNING  OF  ITERATION  LOOP 

REBAR 

79 

200 

NC  =  NC+1 

REBAR 

80 

DO  210  1=1,4 

REBAR 

81 

SR3 ( I ) =SR1 ( I ) 

REBAR 

82 

210 

SR4 ( I ) =SR2 ( I ) 

REBAR 

83 

TEVP=TEVPSV 

REBAR 

84 

ZEVP  =  ZEVPSV 

REBAR 

85 

Y  =  YSV 

REBAR 

86 

I H= I HSV 

REBAR 

87 

PS=PS1  $  PC=PC1 

REBAR 

88 

RX  =  SR4 ( 1 ) -PC  $  RY  =SR4 ( 2 ) - PC  $  RZ  =  SR4(3)-PC  $  RXY  =  SR4(4) 

REBAR 

89 

DEST  = ( DEC ( 1  ) +DEC ( 2 ) +DEC  C  3 ) )/3. 

REBAR 

90 

RH=ROLD* ( 2 . -DEST ) / ( 2 . +DEST ) 

REBAR 

91 

IF  (I  PRINT  .  EQ.  1)  PRINT  1 002 , RH, ROLD , RX, RY , RZ , RXY , ZEVP , TEVP 

REBAR 

92 

CALL  CAP1  (LS,  INjMCj  N,  IH,RH,  ROLD,  E,  DEC(  1  )  ,  DEC  ( 2 )  ,  DECO)  ,  DEC  ( 4  )  , 

REBAR 

93 

1  RX, RY, RZ, RXY, ZEVP, IC, JC,TEVP) 

7/31/79 

155 

IF  (IPRINT  .EQ.  1)  PRINT  1 003, RH, ROLD, RX, RY, RZ, RXY, ZEVP, TEVP 

REBAR 

95 

PC= - ( RX+RY+RZ ) /3 . 

REBAR 

96 

SR4 ( 1  ) =  RX+PC  S  SR4 ( 2 ) =RY+PC  $  SR4(3)=RZ+PC  $  SR4(4)=RXY 

REBAR 

97 

DEST  = ( DES ( 1  ) +DES ( 2 ) +DES ( 3 ) )/3. 

REBAR 

98 

D=DSTL# ( 2 . -DEST) /C 2. +DEST ) 

REBAR 

99 

CALL  EPLASCJC, I C, MS , SR3, PS, DES , ESC, D, Y ) 

REBAR 

1  00 

SCTEST  =  SR4 ( 1  ) - PC  $  SSTEST  =  SR3(1)-PS 

REBAR 

101 

IF  (IPRINT  .EQ.  1)  PRINT  1 001 , NC, DES ( 1 ) , DEC ( 1 ) , PC, PS , ( SRI ( I ) , I = 1 , 4 

REBAR 

102 

1  ) ,  (SR2C I ) ,  I =1 ,4) ,  ( SR3 ( I  ) ,  I  *  1 , 4  )  ,  (SR4C I  ) ,  I =1 , 4 ), SCTEST , SSTEST 

REBAR 

103 

IF  ( ABS ( SR4 ( 1 ) -PC“SR3 ( 1 ) +PS )  . LT .  CRIT)  GO  TO  290 

REBAR 

104 

DEZA=DES ( 1 )  $  DSZA=SR4( 1 ) -SR3( 1 )  -PC+PS 

REBAR 

1  05 

IF  (NC  . EQ.  1 )  GO  TO  250 

REBAR 

106 

IF  (NC  .LT.  12)  GO  TO  260 

REBAR 

1  07 

IF  ( NTRY  .LT.  5)  GO  TO  450 

REBAR 

108 

C 

ABORT  PROVISION 

REBAR 

109 

PRINT  1 240, JC,  I C, N, PS, PC, SSTEST, SCTEST, SRI , SR2, SR3 , SR4  ,  DES,  DEC 

REBAR 

1  10 

1  240 

FORMAT ( IX, *  ABORT  IN  REBAR  FOR  NTRY  EQUALS  5  FOR  J=#,I5,*  I=*,I5, 

REBAR 

1  1  1 

1  *  ON  CYCLE  * ,  15,/,  IX,*  PS=*,E10.3,*  PC=*,E10.3,#  SSTEST*  * , E 1 0 . 3, 

REBAR 

1  12 

2  *  SCTEST**, El  0. 3/, *  SR 1  =  * , 4E1 0.3,*  SR2=* , 4E1 0 . 3, /, *  SR3* * , 4E 1 0 . 3, 

REBAR 

1  1  3 

3  *  SR4=* , 4E1 0. 3, /, *  DES= * , 4E 1 0 . 3 , *  DEC* * , 4E 1 0 . 3 ) 

REBAR 

1  14 

GO  TO  320 

REBAR 

1  1  5 

C 

PREPARATION  FOR  SECOND  ITERATION 

REBAR 

1  1  6 

250 

DES ( 1 ) =DES( 1 ) + ( SR4 ( 1 ) -PC-SR3( 1 ) +PS ) / ( ESC ( MC, 2 ) *FS/ ( 1 . -FS)+ESC(MS, 2 

REBAR 

1  17 

1  )  ) 

REBAR 

1  1  8 

DEC ( 1 ) = (DE( 1 ) *RR  -DES ( 1 ) #FS ) / ( 1 , -FS ) 

REBAR 

1  1  9 

GO  TO  280 

REBAR 

1  20 

C 

REGULA  FALSI  BRANCHES 

REBAR 

121 

260 

IF  (NC  . EQ.  2)  GO  TO  262 

REBAR 

122 

IF  (DSZC  .GT.  0.)  GO  TO  265 

REBAR 

123 

IF  (DSZB  .LT.  0.)  GO  TO  262 

REBAR 

124 

IF  ( DSZA  .GT.  0.)  GO  TO  265 

REBAR 

125 

262 

DES ( 1 ) =DEZA+ ( DEZB-DEZA ) / ( DSZB-DSZA ) * ( -DSZA) 

REBAR 

126 

IF  (NC  .EQ.  6  .OR.  NC  . EQ .  10)  DES ( 1 ) =  0 . 5* ( DEZA+DEZB ) 

REBAR 

1  27 

GO  TO  270 

REBAR 

1  28 

265 

DES ( 1 ) =DEZA+( DEZC-DEZA)/( DSZC -DSZA) *( -DSZA) 

REBAR 

1  29 

IF  (NC  .EQ.  6  OR.  NC  . EQ .  10)  DES ( 1 ) =0 . 5* ( DEZA+DEZC ) 

REBAR 

1  30 

270 

DEC ( 1 ) = ( DE( 1 ) *RR  -DES ( 1 ) *FS)/( 1 . -FS) 

REBAR 

1  31 

IF  (NC  .GT.  2)  GO  TO  275 

REBAR 

1  32 

IF  (DSZA  .LT.  DSZB)  283,279 

REBAR 

133 

275 

IF  (DSZA  .GT.  DSZB  .OR.  DSZA  . LT .  DSZC)  GO  TO  277 

REBAR 

134 

IF  (DSZA  .LT.  0.)  283,280 

REBAR 

1  35 

277 

IF  (DSZB  .LT.  0.  .AND.  DSZA  . GT .  DSZB)  GO  TO  279 

REBAR 

136 

IF  (DSZC  .GT.  0.  .AND,  DSZA  .GT.  DSZC)  282,200 

REBAR 

1  37 

279 

DSZC=DSZB  $  DEZC=DEZB 

REBAR 

138 

260 

DSZB=DSZA  $  DEZB=DEZA  $  GO  TO  200 

REBAR 

139 

262 

DSZB=DSZC  $  DEZB=DEZC 

REBAR 

140 

283 

DSZC=DSZA  $  DEZC=DEZA  $  GO  TO  200 

REBAR 

141 

c  *******  *********** 

REBAR 

142 

c 

END  OF  ITERATION  LOOP,  RESET  FOR  NEXT  STRAIN  INCREMENT 

REBAR 

143 

290 

DO  295  1=1,4 

REBAR 

144 

SRI ( I ) =SR3 ( I ) 

REBAR 

145 

295 

SR2 ( I ) =SR4 ( I ) 

REBAR 

146 

I HSV= I H 

REBAR 

147 

YSV=Y 

REBAR 

148 

TEVPSV=  TEVP 

REBAR 

149 

ZEVPSV=ZEVP 

REBAR 

150 

FS=FS* ( 1 . +DES ( 1 ) )/(FS* ( 1 . +DES( 1 ) ) + ( 1 . - FS ) # ( 1 . +DEC( 1 ) ) ) 

REBAR 

151 
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SUBROUTINE  REBAR  (Concluded) 


DSTL  =  D 

REBAR 

1  52 

R0LD=RH 

REBAR 

1  53 

PS1=PS  $  PC1=PC 

REBAR 

1  54 

RL=RL+RR 

REBAR 

1  55 

IF  (RL  . LT.  .999)  GO  TO  180 

REBAR 

1  56 

c 

ENDING  ROUTI NE 

REBAR 

157 

320 

CONTI NUE 

REBAR 

1  58 

DO  330  1=1,4 

REBAR 

1  59 

SRC  I  ) =  SR4 (  I  ) * ( 1  .  -FS)+SR3( I  )*FS 

REBAR 

160 

330 

SRS ( I ) =SR3 ( I ) -PS 

REBAR 

161 

SRS ( 4 ) =SR3 ( 4 ) 

REBAR 

1  62 

THETA2= ( THETA+DTHETA) *2. 

REBAR 

1  63 

SI N2TH1 =SI NCTHETA2)  $  C0S2TH 1 =COS ( THETA2 ) 

REBAR 

1  64 

SX= ( SR ( 1 )+SR(2)+(SR( 1 ) -SR ( 2 ) )*C0S2TH1 )/2. -SR ( 4 ) *S I N2TH 1 

REBAR 

165 

SY= (SRC  1  )+SR(2) - (SRC  1  ) -SR (2) )#C0S2TH1  ) /2 . +SR ( 4 ) *S I N2TH1 

REBAR 

1  66 

S2=SR ( 3 ) 

REBAR 

167 

TXY  =  + ( SR ( 1  ) -SRC  2)  )/2. *S I N2TH 1 +SR ( 4 ) #C0S2TH1 

REBAR 

1  68 

IF  (IPRINT  .EQ.  1)  PRINT  1120,  (SRC  I  )  ,  1  =  1,4), SX, SY , SZ, TXY, C0S2TH1  , 

REBAR 

1  69 

1  SIN2TH1 

REBAR 

1  70 

P=PC*( 1 . -FS)+PS*FS 

REBAR 

1  71 

RETURN 

REBAR 

1  72 

C 

PROVISION  TO  CUT  STRAIN  INCREMENTS 

REBAR 

1  73 

450 

NTRY  =  NTRY  +  1 

REBAR 

174 

IF  (NTRY  .EQ.  5)  IPRINT=1 

REBAR 

175 

RR=RR/3 . 

REBAR 

176 

GO  TO  120 

REBAR 

1  77 

1001 

FORMAT (IX,*  NC=*I5,*  DESC 1 ) , DEC ( 1 ) =# ,  1P2E10.3,*  PC=*,E10.3,*  PS=* 

REBAR 

1  78 

1 , El  0. 3, /,  IX, *  SR 1 =  * , 4E 1 0.3,*  SR2  =  * , 4E1 0 . 3, / ,  1 X, *  SR3  =  * , 4E1 0 . 3, 

REBAR 

179 

2*  SR4=  * , 4E 1 0 . 3/ ,  1 X , *  (CONCRETE  STRESS)  SR4 (1)“PC=*,E12.5,*  (STEEL 

REBAR 

180 

3STRESS )  SR3(1  ) - PS= * , El  2 . 5 ) 

REBAR 

1  81 

1  002 

FORMAT ( *  BEFORE  CAP, RH, R0LD=*1P2E10. 3, 

REBAR 

1  82 

1  *  RX , RY , RZ , RXY  =  *4E1 0 . 3 , *  ZEVP , TEVP= *2E 1 0 . 3 ) 

REBAR 

1  83 

1  003 

FORMAT  (*  AFTER  CAP,  RH , ROLD= # 1 P2E 1 0 . 3 , 

REBAR 

1  84 

1  *  RX, RY , RZ, RXY  =  *4E 1 0 . 3 , *  ZEVP, TEVP=*2E1 0 . 3 ) 

REBAR 

1  85 

1  1  20 

FORMAT ( #  SR 1 , SR 2, SR 3, SR4  =  *4E 1 0.3/*  SX, SY , SZ, TXY  =  *4E1 0 . 3/*  C0S2TH , 

REBAR 

1  86 

1  S I N2TH=  *2E1 0 . 3 ) 

REBAR 

187 

END 

REBAR 

1  88 
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SUBROUTINE  REDR 


SUBROUTINE  REDR < NA ,NB , I N , NO )  REDR 

TO  PREPARE  TAPE4  FDR  READING.  COPY  FROM  INPUT  TO  TAPE4  WITH  THEREDR 
COMMAND  -  -  C0PYCR(INPUT.TAPE4)  REDR 

THE  INPUT  CARDS  SHOULD  BE  IN  NDRMAL  FORM  FOR  MATERIALS  INPUT.  REUR 

WITH  BLANKS  IN  FIRST  COLUMN.  THE  INPUT  CARDS  ARE  BETWEEN  789  REDR 

CARDS  BUT  THERE  ARE  NO  SEPARATORS  BETWEEN  MATERIALS.  REDR 

REWIND  IN  REDR 

NN»0  REDR 

IDD»1H  REDR 

10  READ  (IN. 100)  IND.NAA.NBB  REDR 

NN=NN+1  REDR 

IF  (EDF ( IN) )  15.20  REOR 

15  PRINT  110. IDD.NA.NB, IND.NAA.NBB  REDR 

STOP  2254  REUR 

20  IF  (NA.NE.NAA  .DR.  (NB.NE.NBB  .AND.  N0.EQ.2))  GO  TO  10  REDR 

REWIND  IN  REDR 

NNsNN-1  REDR 

IF  (NN  .EO.  0)  RETURN  REUR 

DD  40  N= 1 , NN  REUR 

READ  (IN. 100)  IND  REDR 

40  CONTINUE  REDP 

RETURN  REDR 

100  FDRMAT  (A1.A9.A10)  REDR 

110  FDRMAT  ( 1 5H  SEARCHING  FOR  A1.A9.A10.8H.  FOUND  A1.A9.A10)  REDR 

END  PEUR 


2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 


294 


cjcjcjcjcjo  cj  u  n 


SUBROUTINE  RELAX 


SUBROUTINE  RELAX  ( I CON f SD t Y2 , DRO * COEF , N * J * M , ANM *  ANT , QT * TSR , YU ,  RELAX 

1  YlfINSR)  RELAX 

relax 

called  by  hstress  to  compute  deviator  stress  according  to  relax 

STANDARD  ANELASTIC  AND  TWO-PARAMETER  YIELD  MODELS »  NDS=1  AND  4.  RELAX 
INPUT  -  ALL  FORMAL  PARAMETERS  RELAX 

OUTPUT  -  SDt  ICON *  YOLD=YNEW •  RELAX 

RELAX 

DIMENSION  TSR ( 6  f 30 )  RELAX 

YOLD  =  0  •  6667**  Y2  RELAX 

YAD  =  0 • 6667*YD  RELAX 

YNOT=  0.6667*Y1  RELAX 

RELAX 

TRLX=TSR(Mtl5)  $  TY=TSR(M*16)  $  SDO=SD  $  ICOR=ICON  RELAX 
YNEW=YOLD  $  L=0  RELAX 

IN=MaXQ (2* INSR) /2  RELAX 

IF  (ICON  .EG.  2)10*2  RELAX 

INITIAL  CONDITION  OUTSIDE  OF  ELASTIC  ZONE  RELAX 

L=1  $  GO  TO  (4*3) IN  RELAX 

XPY=EXP (-OT/TY)  RELAX 

YNEW=YNOT  ♦  (  YOLD-YNOT)  *XPY*  ABS  (COEF )  *TY/DT*  (  1 .-XPY) *.5*  (  1  .  *SIGN  (  1  .  *  RELAX 
1DR0)*SIGN(1.*SD0) )  RELAX 

YAV6  =  ( YNEW^ YOLD) /2.  $  YSTAR  =  S I ON { Y A VG , sDO )  $  Go  TO  5  RELAX 

4  YSTAR  =  SIGN ( YOLD  *  SDO )  RELAX 

5  XPO=EXP (-UT/TRLX)  RELAX 

SD  =  YSTAR  ♦  (SDO-YSTAR)*XPO  ♦  COEF*TRLX/DT*  (  1  . -XPO )  RELAX 

C  CHECK  IF  DEVIATOR  CROSSES  INTO  ELASTIC  ZONE.  IF  SO*  RECALCULATE  RERELAX 

IF ( AB  S ( SD ) .GE.YNEW. AND. SIGN ( 1 . * SD ) . EQ . SI GN ( 1 . * SDO ) )30*6  RELAX 

6  TC  =  (SIGN (YNEWtSOO)-SDO) / ( SD-SDO ) *DT  $  L=2  RELAX 

GO  TO  (9*7) IN  RELAX 

7  YNE W=YNOT ♦ ( YOLD-YNOT ) *EXP ( -TC/TY )  RELAX 

YAVG  =  ( YNEW+YOLD) /2.  $  YSTAR  =  S I GN ( Y A VG * SDO )  RELAX 

9  XPO  =  EXP (-TC/TRLX)  RELAX 

SD  =  YSTAR^ (SDO-YSTAR) *XPO^COEF*TRLX/DT*  ( 1 .-XPO) ♦COEF  * (DT-TC) /DT  RELAX 

C  CHECK  IF  DEVIATOR  CROSSES  OVER  INTO  OTHER  SIDE  OF  ZONE  RELAX 

IF  ( ABS (SD) .GT.YNEW) U , 10  RELAX 

10  ICON  =25  L= 3  $  GO  TO  35  RtLAX 

11  IF  ( SIGN  ( l • *  SD ) .EG.SIGN(l.*SDO) )30*12  RELAX 

C  RECALCULATE  TIME  DURING  WHICH  RELAXATION  OCCURS  RELAX 

12  TK  =  (SD+SIGN (YNEW* SDO) ) /(SD-SIGN (YNEW*SDO) ) * (DT-TC)  $L  =  4  RELAX 

GO  TO  (25*13) IN  RELAX 

13  XPY=EXP (-TK/TY)  RELAX 

YNEW=YNOT ♦ ( YNEW- YNOT) *XPY  + ABS (COEF) *TY/DT* ( 1 .-XPY )  RELAX 

YAVG  =  (YNEW4Y0LD)/2.  $  YSTAR  =  S I GN ( Y A VG * SD )  $  GO  TO  25  RELAX 

C  NOW  CONSIDER  INITIAL  CONDITIONS  INSIDE  ELASTIC  ZONE  RELAX 

10  SD  =SDO  ♦  COEF  RELAX 

C  CHECK  IF  DEVIATOR  CROSSES  ZONE  BOUNDARY  RELAX 

IF  (ABS (SD) .GT. YOLD) 19*35  RELAX 

C  CHANGE  CONDITION  VARIABLE  AND  RECALCULATE  DEVIaTOR  WITH  REL A Xa T I ONREL A X 

19  YSTAR  =  SIGN ( YOLD*SD)  $  L=5  $  TK= ( SU-YST AR )/( SD-SDO ) *DT  RELAX 

GO  TO  (25*20) IN  RELAX 

20  YNE W* YNOT ♦ ABS ( COEF ) *TY/D T* ( 1 . -EXP ( -TK/ T Y ) )  RELAX 

YAVG  =  ( YNE W ♦ YNOT ) /2 •  5  YSTAR  =  S IGN ( Y A VG * SD )  RELAX 

25  ICON  =  2  -  IFIX(SIGN<1.*SD))  RELAX 

SD  =  YSTAR  ♦COEF*TRLX/DT»(l-EXP(-TK/TRLX) )  RELAX 

30  GO  TO  (31*35) IN  RELAX 

C  RECALCULATE  YIELD  STRENGTH  TO  ACCOUNT  FOR  STRAIN  HARDENING  RELAX 

31  YNEW  =  AMIN1 ( AMAXl ( ABS(SD)  *YOLD)  * YOLD  ♦  Y AD» ABS (DRO)  )  RELAX 

IF  ( YNEW. EQ. ABS (SD) )  32*35  RELAX 

32  IC0N  =  2  5  L  =  L ♦ 1 0  RELAX 

35  CONTINUE  RELAX 

Y2  =  1.5*  YNEW  RELAX 

RETURN  RELAX 

END  RELAX 
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SUBROUTINE  REZONE 


SUBROUTINE  REZONE 


3 


INCREASES  CELL  SIZES  TO  GIVE  MORE  UNIFORM  DISTRIBUTION 

*  STARTS  REZONING  AT  JREZON  AND  WORKS  TOWARD  JINIT 

*  DOES  NOT  DISTURB  LOCATION  OF  INTERFACES,  JEDITS,  OR  SPALLS 

INPUT  -  NREZON,  SSTOPM . 

OUTPUT  -  ARRAY  VARIABLES  X,  C,  CHL,  D,  DHL,  EHL,  H,  NEM,  NET,  P,  P 
R,  S,  SHL,  T,  U,  UHL,  YHL ,  ZHL ,  AND  JEDIT,  JBND . 

I NTEGER  H, POROUS, PRESS, RI NTER, SOLI D, SPALL 
REAL  MATL, NEM, NET, NEMH, NETH 
MISCELLANEOUS 

COMP  ION  AZEROC 1  ) , CEF, CKS , DAVG , DELT I M , D I SCPT ( 1 0 ) , DOLD, DRHO, DTMAX, 

1  DTMI N, DTN, DTNH , DU, DX, EOLD, F, FAC, FI RST, J, JCYCS, JINIT, 

2  JFI N, JREZON (15), JSMAX, JSTAR, JTS, LSUB ( 30 ) , M, MAXPR ( 30 ) , N, NCYCS, 

3  NED  I T, NPERN , NR, NREZON, NSCRB(6) , NSEPRAT, NSPALL , NTEDT, 

4  N^EX, NTR( 15) , POLD, P6 ( 20) , R ( 30 ) , RLAST, SLAST, SMAX, TED  I T ( 50) , 

5  TF, TI ME, TJ, TREZON, TS, T6( 20) , ULAST, UOLD, UZERO, XLAST , XNOW, XOLD 

1  , X JD I T ( 20 ) , MS 

HALFSTEP  VALUES 

COMMON  DH, DHLAST, DUH, EH, PH, RH, RHLAST , SH, SHLAST , UH, UHLAST, XH, XHLAST 
1  , NEMH, NETH 

CONDITION  INDICATORS 

COMMON  I NF, LI NTER, MI RROR, NORMAL, POROUS, PRESS, RI NTER, SOLI D, SPALL 
CELL  LAYOUT 

COMMON  DXXC30) , JBND (30) , JMATC30) , NAUTO, MATLC 6, 2 ) , NLAYER, NMTRLS, 

1  THK ( 30 ) 


COORDINATE  ARRAYS 

COMMON/COORD/X ( 200 ) , X0C200) , CHLC200) , DHL ( 200 ) , DPDD ( 200 ) , DPDE ( 200 ) , 

1  EHL (200) , H(200, 3) , NEM (200) , NET (200) , PHL(200) , RHL ( 200 ) , SDT ( 200 ) , 

2  SHL (200) , T(200) , U ( 200 ) , YHL ( 200 ) , ZHL (200) 

COMMON  /JED/ JED  I T( 1 00) , JNUM( 100), JTYP( 1 00) , NAME2(40) , JEDSI Z, 

1  MODLUS, NERR, NJED I T , NTAPE 
NAMED  COMMON 
REAL  MU, MUM 

COMMON  /EOS/  EQSTA( 6 ) , EQSTC(6) , EQSTD ( 6 ) , EQSTE ( 6 ) , EQSTG ( 6 ) , 

1  EQSTH ( 6 ) , EQSTN ( 6 ) , EQSTS ( 6 ) , EQSTV ( 6 ) , CZQ ( 6 ) , CWQ ( 6 ) , C2 ( 6 ) 

COMMON  /MELT/  EMELT (6,8), GMELT (6,8),SPH(6), THERM ( 6,8) 

COMMON  /RHO/  RHO ( 6 ) , RHOS ( 6 ) 

COMMON  /TSR/  TSR ( 6, 30 ) , EXMAT ( 6, 20 ) , TENS ( 6, 3 ) 

COMMON  /Y/  Y0(6),YADD(6), MU ( 6 ) , MUM, YADDM 

COMMON  /IND/  I  EOS ( 6 ) ,  I NDK ( 20 ) , NALPHA , NCMP ( 6 ) , NFR ( 6 ) , NPOR ( 6 ) , 

1  NDS ( 6 ) , NPR ( 6 ) , NCON ( 6 ) , NVAR(6) 

COMMON  /RAD/  SSTOP ( 9 ) , START ( 9 ) , SDURM , SSTOPM , NSPEC , SS J , JSS ,  I  PLOT ( 4 ) 
1  , XMAX ( 4 ) , XM I N ( 4 ) , YMAX ( 4 ) , YM I N ( 4 ) , IA(7), I T I TLE ( 24 ) , NARZ, TARZ 

COMMON/SS/SS ( 500 ) 

COMMON /PES/ COM ( 2000 ) , LVAR(200) , LVMAX 

DIMENSION  CC (20) , EC ( 20 ) , HC (20, 3) , MASS (21 ) , MOM (20, 2) , DC (20) , 

1  PC ( 20 ) , RC ( 21 ),SC(20),XC(20),YC(20) , ANEM ( 20 ) , ANET ( 20 ) 

DIMENSION  NEWJED ( 1 00 ) 

D I  MENS  I  ON  ASC ( 20 ) , PSC ( 20 ) , RSC ( 20 ) , RVSC ( 20 ) , ENSC ( 20 ) 

DIMENSION  SSS ( 5 ) , SSC (20, 5 ) 

INTEGER  HC, H J0LD2 

REAL  MASS, MOM, MASLAST, MOMLAST , MASNEXT 


CALL  SECOND (XNOW) 

SECTION  1  -  LOCATE  JREZON  WITH  RESPECT  TO  MATERIAL  AND  JEDITS 

JREZ=  JREZON ( NR ) 

DTD=0 . 

IF  (NREZON  .GT.  0)  GO  TO  7 
IF  (JTS  .GE.  JFIN-2)  RETURN 
CALL  EDIT 

DTS*=(X( JTS+1 )-X( JTS) )/CHL( JTS) 

DTD=AM I N1 (2. *DTS, 1 ,4*DTMAX) 

JREZ= JTS 
JBEG= 1 

DO  5  L* 1 , NLAYER 
JBNDM= JBND ( L ) - 1 


REZONE 

2 

REZONE 

3 

REZONE 

4 

REZONE 

5 

REZONE 

6 

REZONE 

7 

REZONE 

8 

REZONE 

9 

REZONE 

1  0 

REZONE 

1  1 

PUFCOM 

2 

PUFCOM 

3 

PUFCOM 

4 

PUFCOM 

5 

PUFCOM 

6 

PUFCOM 

7 

PUFCOM 

8 

PUFCOM 

9 

PUFCOM 

1  0 

PUFCOM 

1  1 

PUFCOM 

1  2 

PUFCOM 

1  3 

PUFCOM 

14 

PUFCOM 

15 

PUFCOM 

1  6 

PUFCOM 

1  7 

PUFCOM 

1  8 

PUFCOM 

1  9 

PUFCOM 

20 

COORDCOM 

2 

COORDCOM 

3 

COORDCOM 

4 

COORDCOM 

5 

JEDCOM 

2 

JEDCOM 

3 

EQSTCOM 

2 

EQSTCOM 

3 

EQSTCOM 

4 

EQSTCOM 

5 

EQSTCOM 

6 

EQSTCOM 

7 

EQSTCOM 

8 

EQSTCOM 

9 

INDCOM 

2 

INDCOM 

3 

RADCOM 

2 

RADCOM 

3 

SSCOM 

2 

REZONE 

1  9 

REZONE 

20 

10/8/79 

4 

REZONE 

22 

REZONE 

23 

REZONE 

24 

REZONE 

25 

REZONE 

26 

REZONE 

27 

REZONE 

28 

REZONE 

29 

REZONE 

30 

REZONE 

31 

REZONE 

32 

REZONE 

33 

REZONE 

34 

REZONE 

35 

REZONE 

36 

REZONE 

37 

REZONE 

38 

REZONE 

39 

REZONE 

40 

REZONE 

41 

REZONE 

42 

REZONE 

43 

REZONE 

44 

REZONE 

45 
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SUBROUTINE  REZONE  (Continued) 


DO  4  JS  =  JBEG , JBNDM 

REZONE 

46 

I F ( ( X ( JS+1 ) -X ( JS ) ) /CHL ( JS )  .GT.  DTD)  GO  TO  4 

REZONE 

47 

JREZ= JS+ 1 

REZONE 

48 

4 

CONTINUE 

REZONE 

49 

JBEG  =  JBNDM  +  2 

REZONE 

50 

5 

CONTINUE 

REZONE 

51 

7 

JREZ  =  JLAST  =  M I  NO ( JREZ,  JFIN-1 ) 

REZONE 

52 

IF  ( JREZ  , LE .  JINIT+1)  RETURN 

REZONE 

53 

L  =  0 

REZONE 

54 

8 

L  =  L+ 1 

REZONE 

55 

IF  (JREZ  .GT.  JBND  (  L  )  + 1  )  GO  TO  8 

REZONE 

56 

IF  (JREZ  .EG.  JBND ( L ) + 1 )  JLAST= JLAST - 1 

REZONE 

57 

MASl  AST  =  ZHL( JLAST) 

REZONE 

58 

MOML.AST  =  0 . 5*MASLAST *  U(  JLAST  ) 

REZONE 

59 

TLAST=T( JLAST) 

REZONE 

60 

C 

**  SET  JOLD ,  THE  OLD  COORDINATE  VALUE,  AND  JNEW,  THE  NEW  VALUE 

REZONE 

61 

C 

* *  REZONING  OCCURS  FOR  CELLS  BETWEEN  JOLD  AND  JLAST.  MIDCELL 

REZONE 

62 

C 

**  QUANTITIES  ARE  SET  FOR  JLAST-1  WHILE  COORDINATE  QUANTITIES  ARE 

REZONE 

63 

C 

**  SET  FOR  JLAST. 

REZONE 

64 

C 

**  SET  DX  (CELL  DIMENSION)  AND  XN  (COORD  TO  LEFT  OF  NEW  CELL)  FOR 

REZONE 

65 

C 

**  FIRST  GROUP  OF  CELLS  TO  BE  REZONED 

REZONE 

66 

XN=X( JLAST-1 )  $  DX=X( JLAST) -XN 

REZONE 

67 

1  1 

LI =L - 1  $  DXX(L) =DX=AMAX1 (DX, DTD*CHL( JLAST-1 )  ) 

REZONE 

68 

DT=DX/CHL( JLAST-1 ) 

REZONE 

69 

JOLD  =  JNEW  =  JLAST- 1  $  NCEL  =  NPART  =  0 

REZONE 

70 

IF  (L  .EG.  1 )  GO  TO  13 

REZONE 

71 

M= JMAT ( L ) 

REZONE 

72 

DO  12  1=1 , LI 

REZONE 

73 

MI  a JMAT ( I  ) 

REZONE 

74 

1  2 

DXX ( I ) =  DXX ( L ) #SQRT ( EQSTC ( M I  ) *RH0S(M) / ( EQSTC(M) *RH0S(MI  ) ) ) 

REZONE 

75 

13 

DO  10  1=1, NJED I T 

REZONE 

76 

1  0 

NEW JED ( I ) = JED  I T ( I  ) 

REZONE 

77 

L0C= 1 1 

REZONE 

78 

WRITE  (6,5011)  JREZ, DT , DTNH 

REZONE 

79 

WRITE  (6,5000)  LOC, JOLD, JNEW, JLAST, L, NJ , NCEL, NPART 

REZONE 

80 

WRITE  (6,5015)  ( I , DXX ( I ) , I = 1 , L ) 

REZONE 

81 

0 

REZONE 

82 

C 

SECTION  2  -  FIND  REZONABLE  SET  OF  CELLS 

REZONE 

83 

C 

REZONE 

84 

C 

TERMINATION  OF  REZONABLE  SET  OF  CELLS  AT  AN  INTERFACE  (PART  1 

10/8/79 

5 

50 

IF  ( L - 1 )  790, 155, 52 

REZONE 

86 

52 

IF  ( J0LD-JBND(L-1 ) -1 )  790,60,155 

REZONE 

87 

60 

NPART a 1  $  HJ0LD2  =  H( JOLD, 2)  $  GO  TO  500 

REZONE 

88 

1  00 

JLAST  =  JOLD- 1 

REZONE 

89 

C 

**  RETURN  WITH  JNEW  SET  TO  LEFT  COORDINATE  OF  BOUNDARY,  JOLD  ON 

REZONE 

90 

1  25 

H ( JNEW+1 , 2 ) =H J0LD2  $  X ( JNEW ) =X ( JOLD- 1 ) 

REZONE 

91 

L  =  L-  1  $  JBND  (  L  )  3  JNEW  $  TLAST  =  T  (  JOLD  -  1  )  $  JNEW=JNEW-1 

REZONE 

92 

JOLD  =  JOLD-2  $  XN  =  X ( JOLD ) 

REZONE 

93 

L0C=1 25 

REZONE 

94 

WRITE  (6,5000)  LOC , JOLD , JNEW , JLAST , L , NJ , NCEL , NPART 

REZONE 

95 

GO  TO  50 

REZONE 

96 

C 

REZONE 

97 

C 

TERMINATION  AT  INITIAL  BOUNDARY  (PART  2) 

REZONE 

98 

155 

I F ( JOLD-JINIT)  790,160,255 

REZONE 

99 

1  60 

NPART  =  2  $  HJ0LD2  =  H( JOLD, 2)  $  GO  TO  500 

REZONE 

100 

200 

H( JNEW+1 ,2)=HJ0LD2  $  DO  205  NJ=1,NJEDIT 

REZONE 

101 

IF  (JOLD  .NE.  JEDIT(NJ))  GO  TO  205 

REZONE 

102 

NEW JED ( N J ) =  JNEW+ 1 

REZONE 

1  03 

GO  TO  800 

REZONE 

1  04 

205 

CONTINUE 

REZONE 

1  05 

GO  TO  800 

REZONE 

106 

REZONE 

1  07 

<255 

CONTINUE 

REZONE 

1  08 

300 

CONTINUE 

REZONE 

109 

C 

REZONE 

1  1  0 

C 

TERMINATION  WHEN  NUMBER  OF  REZONABLE  OLD  CELLS  IS  20  (PART 

REZONE 

1  1  1 

355 

IF  ( (X( JLAST) -X( JOLD) )/DXX(L) -18. )  420,360,360 

REZONE 

1  12 

360 

NPART  =  4  $  GO  TO  500 

REZONE 

1  1  3 

400 

J0LD= JOLD- 1 

REZONE 

1  14 

LOC=400 

REZONE 

1  15 

C 

##  RETURN  WITH  JOLD  AT  PREVIOUS  LOCATION,  JNEW  SET  AT  COORDINATE 

REZONE 

1  16 

C 

**  LEFT.  MIDCELL  QUANTITIES  HAVE  BEEN  RESET  UP  TO  JNEW+1,  COORDI 

REZONE 

1  17 

C 

**  QUANTITIES  UP  TO  JNEW+2 

REZONE 

1  18 

WRITE  (6,5000)  LOC, JOLD, JNEW, JLAST, L, NJ , NCEL, NPART 

REZONE 

1  19 

GO  TO  50 

REZONE 

120 

297 


SUBROUTINE  REZONE  (Continued) 


420 

J0LD= JOLD- 1  $  GO  TO  50 

REZONE 

121 

C 

REZONE 

122 

C 

SECTION  3  -  COMPUTE  NEW  CELL  COORDINATES  AND  PROPERTIES 

REZONE 

123 

C 

REZONE 

1  24 

500 

NQ  =  0 

REZONE 

125 

L0C=500 

REZONE 

1  26 

WRITE  (6,5000)  LOC, JOLD, JNEW, JLAST, L, NJ, NCEL, NPART 

REZONE 

1  27 

510 

NCEL  =  M I  NO ( 20 , MAXI  ( ( X ( JLAST ) -X ( JOLD ) ) /DXX ( L ) + . 65 , 1  .  ) ) 

REZONE 

128 

IF  ( (NCEL-1 )*(NQ-1 )  .EQ.  0)  GO  TO  610 

REZONE 

1  29 

C 

CHECK  WHETHER  REGION  OF  LARGE  CELLS  LIES  TO  LEFT 

REZONE 

1  30 

601 

DXM I N=DXX ( L )  $  JLASTP= JLAST- 1 

REZONE 

131 

L0C=60 1 

REZONE 

1  32 

WRITE  (6,5000)  LOC, JOLD, JNEW, JLAST, L, NJ , NCEL, NPART 

REZONE 

133 

DO  603  JX=JOLD, JLASTP 

REZONE 

134 

DELX=X ( JX+1 ) -X( JX) 

REZONE 

1  35 

IF  ( DELX-DXM I N )  602,603,603 

REZONE 

1  36 

602 

DXM I N=DELX  $  JXMIN=JX 

REZONE 

1  37 

603 

CONTINUE 

REZONE 

138 

IF  ( DXM I N- 0 . 8*  DXX ( L ) )  604,750,750 

REZONE 

1  39 

604 

JX= JXM I N+1 

REZONE 

140 

DO  605  I = JOLD , JXM I N 

REZONE 

141 

JX=JX-1  $  DELX=X( JX+1 ) -X( JX) 

REZONE 

142 

IF  (DELX-DXX(L) )  605,605,608 

REZONE 

143 

605 

CONTINUE  $  GO  TO  610 

REZONE 

144 

606 

JOLD  =  JX+1  $  NPART  =  4 

REZONE 

145 

L0C=608 

REZONE 

146 

WRITE  (6,5000)  LOC, JOLD, JNEW, JLAST , L , NJ , NCEL, NPART 

REZONE 

147 

NQ  = 1  $  GO  TO  510 

REZONE 

148 

C 

REZONE 

149 

C 

BEGIN  COMPUTATIONS  FOR  NEW  COORDINATES 

REZONE 

1  50 

61  0 

NCEL=MINO( JLAST- JOLD, NCEL) 

REZONE 

1  51 

JOLDR= JLAST 

REZONE 

152 

DX= (X( JLAST) -X( JOLD) ) /NCEL 

REZONE 

1  53 

XSTART=X( JLAST)  $  XN=XSTART-DX 

REZONE 

1  54 

C 

*#  XN  IS  NEW  COORDINATE  LOCATION 

REZONE 

1  55 

C 

##  DX  IS  NEW  CELL  DIMENSION 

REZONE 

1  56 

MOM ( 1,1) =MOMLAST 

REZONE 

157 

MAS£ ( 1 ) =MASLAST 

REZONE 

158 

LOC=  6 1 0 

REZONE 

1  59 

WRITE  (  6,5002)  LOC, NCEL , XSTART , DX, XN , RSLAST , MASLAST, MOMLAST 

REZONE 

1  60 

WRITE  (  6,5610) 

REZONE 

1  61 

M= JMAT ( L ) 

REZONE 

1  62 

IF  (NALPHA  .GT.  1)  XSTART  =  XSTART  ## NALPHA 

1 0/8/79 

6 

XNAOLD= XSTART 

10/8/79 

7 

DO  650  1=1, NCEL 

REZONE 

163 

MASS ( I +1 ) = AMAVG= AMSLP=ENGY=CS=RS=PS=SX=YS=0 ,  $  ASUM=PSUM=RSUM= 

REZONE 

164 

1  RVSUM=ENSUM=0. 

REZONE 

1  65 

XNAVALF=XN+DX/2. 

10/8/79 

8 

DXALF=DX 

10/8/79 

9 

IF  (NALPHA  .LE.  1  )  GO  TO  61  1 

1 0/8/79 

10 

XNA  =  XN#  # NALPHA 

10/8/79 

1  1 

XNAVALF=0 . 5* ( XNA+XNAOLD ) 

10/8/79 

1  2 

DXALF=XNAOLD-XNA 

10/8/79 

13 

XNAOLD=XNA 

1 0/8/79 

14 

61  1 

CONTINUE 

10/8/79 

1  5 

DO  612  INS  =  1 , NSPEC 

REZONE 

166 

612 

SSS( INS)  =  0. 

REZONE 

1  67 

HC ( I , 1 ) =SOL I D 

REZONE 

1  66 

HC ( I , 2) =NORMAL 

REZONE 

1  69 

ANEFS=ANETS=0. 

REZONE 

170 

HC ( I , 3 ) =2 

REZONE 

171 

615 

IF  (JLAST  .LT.  1 )  GO  TO  625 

REZONE 

172 

XENC1 =XEND=AMAX1 ( X ( JLAST ), XN ) 

10/8/79 

16 

XJLALF1 =X( JLAST+1 ) 

10/8/79 

17 

XJLALF=X( JLAST) 

1 0/8/79 

18 

IF  (NALPHA  .LE.  1)  GO  TO  616 

1 0/8/79 

1  9 

XEND  =  XEND#  # NALPHA 

10/8/79 

20 

XJLALF1 =XJLALF 1 **NALPHA 

10/8/79 

21 

XJLALF  =  XJLALF*  # NALPHA 

10/8/79 

22 

616 

CONTINUE 

1 0/8/79 

23 

IF  (XSTART-XEND)  621,621,619 

REZONE 

174 

61  9 

DMASS=ZHL ( JLAST ) * ( XSTART-XEND ) / ( XJLALF1 -XJLALF ) 

10/8/79 

24 

MASS ( 1+1 ) =MASS ( 1+1 ) +DMASS 

REZONE 

1  76 

UJ=U( JLAST) 

REZONE 

177 

DUOLD=U( JLAST+1 ) -UJ 

REZONE 

178 

SUBROUTINE  REZONE  (Continued) 


DXOLD=X JLALF1 -XJLALF 

1 0/8/79 

25 

XS 1 =0 . 5* ( XSTART+XEND ) -XNAVALF 

10/8/79 

26 

XS2=XSTART-XEND 

REZONE 

181 

U1 =UJ+DUOLD* ( XEND-XJLALF ) /DXOLD 

1 0/8/79 

27 

U2  =  UJ+DUOLD# ( XSTART -XJLALF ) /DXOLD 

1 0/8/79 

28 

AMAVG  =  0 . 25* DM ASS* ( U 1 +U2)  +  AMAVG 

REZONE 

184 

AMSLP=DMASS/DXALF* ( 1 . 5* ( U2+U1 )*XS1 +0 . 25* ( U2-U1 ) *XS2)+AMSLP 

1 0/8/79 

29 

ENGY  =  ENGY  +  DMASS*  EHL ( JLAST ) 

REZONE 

186 

IF  (TIME  .0T.  SSTOPM)  GO  TO  620 

REZONE 

187 

DO  6201  I NS= 1 , NSPEC 

REZONE 

188 

JF= JF I N* ( INS-1 ) + JLAST 

REZONE 

189 

6201 

SSS( I  NS) =SSS( I  NS ) +DMASS*SS( JF ) 

REZONE 

1  90 

620 

CONTINUE 

REZONE 

191 

RS=RS+DMASS*RHL( JLAST) 

REZONE 

192 

PS=PS+DMASS*PHL ( JLAST ) 

REZONE 

1  93 

SX=SX+DMASS*SHL ( JLAST ) 

REZONE 

194 

YS=YS+DMASS*YHL( JLAST) 

REZONE 

195 

CS  =  CS  +  DM ASS  *  CHL ( J  LAST ) 

REZONE 

1  96 

ANEMS= ANEMS+DMASS*NEM ( JLAST ) 

REZONE 

1  97 

ANETS=ANETS+DMASS*NET ( JLAST ) 

REZONE 

1  98 

LL=LVAR( JLAST) 

REZONE 

1  99 

IF  (LL  .EQ.  0)  GO  TO  6205 

REZONE 

200 

ASUM= ASUM+DMASS*COM ( LL+2) 

REZONE 

201 

PSUM  =  PSUM  +  DMASS*COM ( LL+1  ) 

REZONE 

202 

RSUM=RSUM+DMASS*COM ( LL ) 

REZONE 

203 

RVSUM=RVSUM+DMASS#COM ( LL+3 ) 

REZONE 

204 

ENSUM=ENSUM+DMASS#COM ( LL+4 ) 

REZONE 

205 

6205 

CONTI NUE 

REZONE 

206 

HC( I , 2) =MI N0( HC( I ,2) , H( JLAST, 2) ) 

REZONE 

207 

XSTART  =  XEND 

REZONE 

208 

IF  ( C  H  C JLAST,  1  )  .EQ.  5R  P  .OR.  H(JLAST,1)  . EQ .  5R  Q  .OR.  H 

REZONE 

209 

1  (JLAST, 1)  .EQ.  5R  T)  .AND.  HC( 1,1)  . EQ .  SOLI D) HC( I , 1 ) =P0ROUS 

REZONE 

21  0 

IF  ( H ( JLAST , 1 )  .EQ.  5R  R  .AND.  HC(I,1)  . NE .  5R  Z)HC(I,1)=5R 

REZONE 

21  1 

1  R 

REZONE 

21  2 

IF  ( H ( JLAST , 1 )  .EQ.  5R  Z)HC(I,1)=5R  Z 

REZONE 

21  3 

HC ( I  ,  3)=MAX0(H( JLAST, 3) , HC( I ,3) ) 

REZONE 

214 

621 

IF  ( XEND1  .LE.  XN)  GO  TO  625 

1 0/8/79 

30 

JLAST  =  JLAST- 1  $  GO  TO  615 

REZONE 

21  6 

625 

XC ( I ) =XN  $  DC ( I ) =MASS ( I +1 ) /DXALF  $  EC ( I ) =ENGY/MASS ( I +1 ) 

10/8/79 

31 

Y C ( I  ) = YS/MASS ( I +1  )  $  SC( I  ) =SX/MASS( I +1  )  $  PC ( I  ) =PS/MASS ( I +1  ) 

REZONE 

218 

CC(  I  ) =CS/MASS ( 1+1 )  $  RC ( I  ) =  RS/MASS ( 1+1  ) 

REZONE 

219 

ASC(I)  =  ASUM/MASS ( I +1 )  $  PSC(I)  =  PSUM/MASS ( I + 1 ) 

REZONE 

220 

RSC(I)  =  RSUM/MASS( 1+1 )  S  RVSC( I )  =  RVSUM/MASS ( I + 1 ) 

REZONE 

221 

ENSC(I)  =  ENSUM/MASS( I +1 ) 

REZONE 

222 

IF  (TIME  . GT.  SSTOPM)  GO  TO  630 

REZONE 

223 

DO  628  I NS= 1 , NSPEC 

REZONE 

224 

628 

SSC( I ,  INS)=SSS( I  NS) /MASS ( 1+1  ) 

REZONE 

225 

630 

CONTI NUE 

REZONE 

226 

MOM ( I , 2)=AMAVG+AMSLP 

REZONE 

227 

MOM ( 1+1,1 ) = AMAVG -AMSLP 

REZONE 

228 

ANEM ( I ) =ANEMS/MASS( 1+1 )  S  ANET ( I ) = ANETS/MASS ( 1+1 ) 

REZONE 

229 

643 

K=  JNEW+1 -I 

REZONE 

230 

L0C=643 

REZONE 

231 

WRITE  (6, 5003)  LOC,K, XC ( I  ) , DC ( I  ) ,MOM( 1,2),  MOM( I +1  ,  1 )  ,  EC ( I  )  ,  RC ( I  )  , 

1 0/8/79 

32 

1  PC ( I ) , SC ( I ) , YC ( I ) ,MASS( I +1 ) , HC (1,1) 

REZONE 

233 

650 

XN=AMAX1 ( XN-DX, X ( JOLD) ) 

REZONE 

234 

T( JNEW+1 ) =TLAST 

REZONE 

235 

DO  6550  N JD= 1 , NJEDIT 

REZONE 

236 

IF  (JEDIT(NJD)  .GT.  JOLDR  .OR.  JEDIT(NJD)  . LT .  JOLD)  GO  TO  6550 

REZONE 

237 

JED=  JED  I T ( NJD ) 

REZONE 

238 

NEW JED (NJD)= JNEW+1 -NCEL 

REZONE 

239 

XJED=0. 5* ( X ( JED ) +X ( JED+ 1 ) ) 

REZONE 

24  0 

DO  6545  I =2, NCEL 

REZONE 

241 

IF  ( X JED  .LT.  0.5*(XC(I  ) +XC ( I  - 1  )))  GO  TO  6545 

REZONE 

242 

NEW JED ( NJD ) = JNEW+2- I 

REZONE 

243 

GO  TO  6550 

REZONE 

244 

6545 

CONTI NUE 

REZONE 

24  5 

6550 

CONTINUE 

REZONE 

24  6 

DO  670  1=1, NCEL 

REZONE 

24  7 

J  =  JNEW  +  1 -  I  $  CHL ( J ) =CC(  I  )  S  DHL ( J ) =DC ( I  ) 

10/8/79 

33 

EHL ( J ) =EC ( I  )  $  PHL ( J ) =PC(  I  )  $  SHL(J)=SC(I) 

REZONE 

249 

YHL ( J ) =YC ( I )  $  ZHL ( J ) =MASS ( I + 1 )  $  H ( J , 1 ) = HC ( I , 1 ) 

REZONE 

250 

NET ( J ) =ANET ( I )  $  NEM ( J ) = ANEM ( I )  $  RHL(J)=RC(I) 

REZONE 

251 

JL= JOLDR+1 -I 

REZONE 

252 

LVAR ( J ) =LVAR( JL ) 

REZONE 

253 

299 
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LL  =  LVAR ( J ) 

REZONE 

254 

IF  (LVAR(J)  .EQ.  0)  GO  TO  6555 

REZONE 

255 

COM ( LL ) =RSC ( I ) 

REZONE 

256 

COM ( LL+1 )=PSC( I ) 

REZONE 

257 

COM ( LL+2 ) = ASC ( I ) 

REZONE 

258 

COM ( LL+3 ) =RVSC ( I ) 

REZONE 

259 

COM ( LL+4 ) =ENSC ( I ) 

REZONE 

260 

6555 

CONTINUE 

REZONE 

261 

IF  (TIME  , GT ,  SSTOPM )  GO  TO  660 

REZONE 

262 

DO  655  I NS= 1 ,  NSPEC 

REZONE 

263 

JF=JFIN*( INS-1 )+J 

REZONE 

264 

655 

SS( JF)=SSC( I , INS) 

REZONE 

265 

660 

CONTINUE 

REZONE 

266 

U(J+1 ) =2 . *(MOM( I , 1 )+MOM( I ,2) )/(MASS< I )+MASS( 1+1 ) ) 

REZONE 

267 

T( J)=TENS(M, 1 )  $  X(J)=XC(I)  $  H( J , 2 ) =HC (1,2) 

REZONE 

268 

H ( J , 3 ) =HC ( I , 3) 

REZONE 

269 

670 

CONTINUE 

REZONE 

270 

MOMLAST  =  MOM ( NCEL  +  1 , 1  ) 

REZONE 

271 

MASLAST  =  MASS ( NCEL+ 1  ) 

REZONE 

272 

TLAST=T ( JOLD) 

REZONE 

273 

GO  TO  (680,680,700,700,685)  NPART 

REZONE 

274 

680 

CONTINUE 

REZONE 

275 

685 

T ( J ) =TLAST 

REZONE 

276 

U( J)=2. *MOMLAST/MASLAST 

REZONE 

277 

MOMLAST  =  MASLAST  =  RSLAST  * 0 . 

REZONE 

278 

700 

CONTINUE 

REZONE 

279 

LOC=700 

REZONE 

280 

WRITE  (6,5000)  LOC, JOLD, JNEW, JLAST , L, NJ , NCEL, NPART 

REZONE 

281 

C 

SET  JNEW  AND  JLAST  IN  PREPARATION  FOR  THE  NEXT 

ZONE  CALCULATIONS 

REZONE 

282 

JNEW  =  J - 1  $  JLAST  =  JOLD 

REZONE 

283 

C 

RETURN  TO  APPROPRIATE  PART  OF  REZONE  FOR  FINAL 

RESETTING 

REZONE 

284 

GO  TO  (100,200,300,400)  NPART 

REZONE 

285 

C 

REZONE 

286 

C 

RENUMBER  CELLS  WITHOUT  REZONING 

REZONE 

287 

750 

T ( JNEW+1 ) =TLAST 

REZONE 

288 

L0C=750 

REZONE 

289 

TLAST=T( JOLD) 

REZONE 

290 

WRITE  (  6,5750) 

REZONE 

291 

752 

JLAST* JLAST- 1  $  DHL ( JNEW ) =DHL ( JLAST ) 

REZONE 

292 

EHL( JNEW) =EHL( JLAST)  $  PHL ( JNEW ) =PHL ( JLAST ) 

REZONE 

293 

IF  (TIME  .GT.  SSTOPM)  GO  TO  754 

REZONE 

294 

DO  753  I NS= 1 , NSPEC 

REZONE 

295 

JF= JF I N* ( INS-1 ) 

REZONE 

296 

753 

SS( JF+JNEW) =SS( JF+JLAST) 

REZONE 

297 

754 

CONTINUE 

REZONE 

296 

SHL( JNEW) =SHL( JLAST)  $  YHL ( JNEW ) =YHL ( JLAST ) 

REZONE 

299 

CHL( JNEW) =CHL( JLAST)  $  ZHL ( JNEW ) =ZHL ( JLAST ) 

REZONE 

300 

H( JNEW, 1 )=H( JLAST, 1 )  $  H ( JNEW, 2 ) =H ( JLAST, 2) 

REZONE 

301 

MASNEXT=ZHL( JLAST)  $  RHL ( JNEW )= RHL ( JLAST ) 

REZONE 

302 

U ( JNEW+1 ) = ( 2 , *MOMLAST+MASNEXT*U( JLAST+1 ) ) / ( MASLAST+MASNEXT ) 

REZONE 

303 

MASLAST  =  MASNEXT 

REZONE 

304 

MOMLAST  = . 5#MASLAST*U ( JLAST) 

REZONE 

305 

T (JNEW ) =T ( JLAST )  $  X ( JNEW ) =X( JLAST) 

REZONE 

306 

NEM( JNEW) =NEM( JLAST)  $  NET ( JNEW ) =NET ( JLAST ) 

REZONE 

307 

H ( JNEW, 3 ) =H ( JLAST, 3 ) 

REZONE 

308 

LVAR ( JNEW ) =  LVAR ( JLAST ) 

REZONE 

309 

DO  7550  NJD= 1 , NJEDIT 

REZONE 

310 

IF  (JEDIT(NJD)  .EQ.  JLAST)  NEW JED ( N JD ) * JNEW 

REZONE 

31  1 

7550 

CONTINUE 

REZONE 

312 

IaJNEW  $  JNEW= JNEW - 1 

REZONE 

313 

WRITE  (  6,5003)  LOC, I , X ( I ) , DHL ( I ) , U ( I +1 ) , EHL ( I ) 

, RHL ( I ) , PHL ( I ), 

REZONE 

314 

1 

1  SHL ( I ) , YHL ( I ) , T ( I ), ZHL( I ) , H ( I , 1 ) 

REZONE 

315 

IF  ( JLAST- JOLD )  790,755,752 

REZONE 

316 

C 

**  JNEW  IS  TO  LEFT  OF  LAST  RENUMBERED  CELL.  JLAST=JOLD,  THE  LAST 

REZONE 

317 

C 

**  OLD  COORDINATE  RENUMBERED. 

REZONE 

318 

755 

CONTINUE 

REZONE 

319 

L0C=755 

REZONE 

320 

WRITE  (6,5000)  LOC, JOLD, JNEW, JLAST, L, NJ, NCEL, NPART 

REZONE 

321 

GO  TO  (760,760,300,400,765)  NPART 

REZONE 

322 

760 

CONTINUE 

REZONE 

323 

765 

U( JNEW+1 ) =2 . * MOMLAST/ MASLAST 

REZONE 

324 

T( JNEW+1 )=T( JLAST) 

REZONE 

325 

MOMLAST=MASLAST=RSLAST*0 . 

REZONE 

326 

L0C=760 

REZONE 

327 

WRITE  (6,5000)  LOC, JOLD, JNEW, JLAST, L, NJ, NCEL, NPART 

REZONE 

326 

300 


SUBROUTINE  REZONE  (Concluded) 


c 

c 

c 

790 

C 

C 

C 

800 


GO  TO  (100, 200 ,  300 , 400)  NPART 
ERROR  MESSAGE 

WRITE  (6,1000)  NPART, JOLD, JNEW, JLAST, NJ, JEDI T( NJ)  ,  L,  JBND( L) 

CALL  EDIT  $  LSUB ( M ) = 1  $  CALL  STORR  $  CALL  SCRIBE  $  STOP 

ENDING  ROUTINE  -  INTERFACE  AND  BOUNDARY  ADJUSTMENTS 


SPALL)  R ( 1 ) =0 . 


J  I  N  I  T  = JNEW+1 
IF  ( H ( J I N I T , 2 )  .EQ. 

DO  820  L= 1 , NLAYER 

JB= JBND ( L )  $  H ( JB , 2) =LI NTER 

IF  ( H ( JB+1 , 2)  . EQ .  SPALL)  GO  TO  820 

U  <  JB  +  1 )=U< JB)=(U< JB)*ZHL< JB-1  )+U< JB+1  )*ZHL( JB  +  1  ) )/<ZHL< JB-1  )  + 

1  ZHL ( JB+1 ) ) 

820  CONTINUE 

WRITE  (6,5825) 

WRITE  (6,5826)  ( JED  I T(NJ) , NJ  =  1  , NJEDIT) 

WRITE  (6,5827)  ( NEW JED ( N J ) , NJ=1 , NJEDIT) 

DO  825  1=1, NJEDIT 
825  JED  I T ( I  ) =NEWJED ( I ) 

840  CALL  EDIT 
900  CONTINUE 

CALL  SECOND ( TW I  X )  $  DUR  =  TW I X-XNOW 

WRITE  (  6,5010)  J I N I T , DUR 

RETURN 

1000  FORMAT  (24H  ERROR  IN  REZONE,  NPART=I3,6H  J0LD=I3,6H  JNEW=I3, 

1  7H  JLAST  =  I  3 , 4H  NJ-M3,11H  JED  I  T  (  N  J  )  =  I  3,  3H  L=I3,9H  JBND(L)  =  I3) 

5000  FORMAT  ( 1 3H  REZONE,  L0C=I3,7H,  J0LD=I3,7H,  JNEW=I3,8H,  JLAST=13, 

1  4H ,  L= I  3 , 5H ,  N J= I  3, 7H ,  NCEL=I3,8H,  NPART=I3) 

5002  FORMAT ( 1 3H  REZONE,  L0C=I3,7H,  NCEL=I3,15H,  XSTART, DX , XN= 1 P3E 1 0 . 3 , 

1  9H ,  RSLAST=1 PEI  0. 3,  1  OH,  MASLAST= 1  PE  1 0 . 3 ,  1  OH,  MOMLAST= 1  PEI  0 . 3 ) 

5003  FORMAT (2I5,1P10E10.3, 3X, R1 ) 

5010  FORMAT ( 1 9H0END  REZONE,  J I N I T= I  3,  1 7H ,  TIME  IN  REZONE = 1  PE 1 0 . 3 , 5H  SEC 
1  ) 


REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 

REZONE 


329 

330 

331 

332 

333 

334 

335 

336 

337 

338 

339 
34  0 
341 
34  2 

343 

344 

345 

346 
34  7 

348 

349 

350 

351 

352 

353 

354 

355 

356 

357 

358 

359 

360 

361 

362 

363 

364 


501  1 

FORMAT 

(//5X, ^BEGINNING  OF  REZONING, 

JREZ  = 

*13,*,  INTENDED  DT*  * 

REZONE 

365 

1  1PE10 

.3,*,  DTNH=*1PE10.3) 

REZONE 

366 

5015 

FORMAT ( 21 H  REZONE, 

DXX  VALUES  , 

6 (  I  8, 

,F9.6)/21X,6<  18, 

F9.6) ) 

REZONE 

367 

561  0 

FORMAT 

( 1 20H  LOG 

J  XC 

DC 

MOM ( 1,2) 

MOM ( 1+1,1) 

REZONE 

368 

1  EC 

RC 

PC 

SC 

YC  MASS ( 1+1 )  HC (1,1) 

REZONE 

369 

2) 

REZONE 

370 

5750 

FORMAT 

( 1 20H  LOC 

J  X 

DHL 

U( I +1  ) 

EHL 

REZONE 

371 

1  RHL 

PHL 

SHL 

YHL 

T 

ZHL  H ( I , 1 ) 

REZONE 

372 

2) 

REZONE 

373 

5825 

FORMAT 

<*  TRANSFORMATION  OF  JED  IT  VALUES* ) 

REZONE 

374 

5826 

FORMAT 

(*  OLD  JEDITS 

=  *1815) 

REZONE 

375 

5827 

FORMAT 

<#  NEW  JEDITS 

=  *1815) 

REZONE 

376 

END 


REZONE 


377 
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SUBROUTINE  SCATTO 


SUBROUTINE  SCATTO  ( XS * ES » EC AL . NPD INT , NS » L » ESUM )  SCATTO  2 

SCATTO  3 

CALLED  BY  OEPDS  TO  DISTRIBUTE  ABSORBED  ENERGY  INTO  PUFF  CELLS. SCATTO  4 
THE  ENERGY  HaS  BEEN  PREVIOUSLY  COMPUTEO  BY  A  FLUORESCENCE  AND  SCATTO  5 
SCATTERING  CDOE  (SUCH  AS  F SC ATT  OF  S.S.S.)  OR  DETERMINED  SCATTO  6 

EXPERIMENTALLY.  DEPOSITION  COORDINATES  MAY  BE  SPACED  ARbl-  SCATTO  7 
TRARILY.  INTERPOLATION  FUNCTION  IS  A  PARABOLA  IN  LOGIE)  VS  X  SCATTO  R 
FITTED  THROUGH  3  DEPOSITION  CODROINATES.  SCATTU  9 

INPUT  -  FORMAL  PARAMETERS  WHICH  CDNTAIN  COORDINATES  (XS)  AT  WHICH  SCATT010 
DOSE  (ES)  IS  KNDwN  *  NPOINT  (NUMBER  OF  CDDROI NATE  POINTS.  ECALSCATTOll 
(CALIBRATION  FACTOR).  AND  NS  (SPECTRUM  NUMBER).  ES  SHOULD 
BE  IN  CAL/CM2.  XS  IN  CM. 

DUTPUT  -  FILLS  SS  ARRAY. 


INTEGER  H, PDRDUS. PRESS, R INTER, SDL  10, SPALL 
REAL  MATL»NEM»NET»NEMH,NETH 
MISCELLANEOUS 

COMMDN  AZERO(l) ,CEF , CKS , Da VG , DELT I M , 01 SCPT ( 1 0 ) ,DDLD,DRHO,DTMAX, 


SCATT012 
SCATT013 
SCATT014 
SCATT015 
PUFCOm 
PUFCOM 
PUFCOM 
PUFCOM 
PUFCOM 
PUFCOM 
PUFCOM 
PUFCOM 

PUFCO'MO 

PUFCOM 1 1 
PUFCDM12 


1  OTMIN,OTN,DTNH,OU,DX,EOLD,F, FAC, FIRST, J, JCYCS, JINIT, 

2  JFIN, JREZDN (15) , JSMAX, JSTAR, JTS.LSUB (30) ,M,MAXPR(30) ,N,NCYCS, 

3  NEDIT,NPERN,NR,NREZ0N,NSCRB(6) .NSEPRAT.NSPALL.NTEUT, 

4  NTEX  »NTR (15) ,PDLD,Pfe(20) , R ( 30 ) .RLAST ,SL AST , SMAX , TEDI T ( 50 ) , 

5  TF,TIME,TJ,TREZON,TS,T6 (20) ,ULAST»UOLD»UZERD,XLAST»XNOW,xOLU 

1  ,XJDIT (20) 

HALFSTEP  VALUES 

COMMDN  DH»DHLAST»0UH»EH,PH,RH,RHLAST,SH,SHLAST»UH,UHLAST,XH,XHLASTPUFC0m13 

1  , NEMH , NETH  PUFCOM14 

CDNDITIDN  INDICATORS  PUFC0“15 

COMMDN  INF.L INTER, MI RRDR.NDRMAL, POROUS, PRESS, R INTER, SOL  ID, SPALL  PUFCOM 16 

CELL  LAYOUT  PUF COM  1 7 

COMMDN  OXX (30) , JBNO(30) , JMAT (30) .NAUTD.MATL (6,2) .NLAYER.NMtRLS,  PUFCOM 18 
1  THK ( 30 )  PUFC0M19 

PUFCOM20 

COORDINATE  ARRAYS  C0DRDC02 

CDMMDN/CDDRD/X (200) ,X0 (200) ,CHL (200) , UHL (200) »OPDD (200) ,OPOE (200) .C0OR0C03 
1  EhL (200) ,H (200,3) , NEM (200) , NET (200) ,PHL(200) ,RHL(200) ,SDT(200) ,  COORUCO4 


92 


2  SHL (200) ,T (200) ,U(200) ,YHL(200) ,ZHL(200) 

NAMED  CDMMDN 
REAL  MU, MUM 

CDMMDN  /EQS/  EQSTA ( 6 ) , EQSTC ( 6 ) , EQSTD < 6 ) , EQSTE < 6 ) ,EQSTG ( 6 
1  EQSTH (fe) ,EQSTN (6) .EQSTS (6) ,EQSTV (6) ,CZQ (6) »CWQ (6) »C2 (6) 

COMMON  /MELT/  EMELT ( 6 , 5 ) , SPH ( 6 ) » THERM ( 6 , 6 ) 

COMMON  /RHD/  RHO (6) ,RHDS (6) 

CDMMDN  /TSR/  TSR ( 6 » 30 ) » EXMAT ( 6 » 20 ) » TENS ( 6 , 3 ) 

COMMDN  /Y/  Y0(6) ,YADD(6) ,MU(6) ,MUM,YADDM 
COMMON  /RAD/  SSTOP(5) ,START(5) , SDURM , SSTOPM , NSPEC , SS J , JSS , I  PLOT ( 4 ) R AOCOM 
1  , XM AX ( 4 ) , XM IN (4 ) »YMAX(4) , YM I N ( 4 ) , I A ( 7 ) , I  TITLE (24) .NARZ.TARZ 
COMMON/SS/SSI500) 

DIMENSION  XS ( 1 ) ,ES(1) 


FACTDR=4.186E7/(SST0P (NS) -START (NS) ) 
ESS=ESUM=o. 

JFINNS=JFIN« (NS-1 ) 

JS1=J=I 

BEGIN  LDDP  FDR  EACH  MATERIAL 
IF  (L  .GT.  1)  JrJBNO(L-l) *1 
XENO-X ( J) 

JBNDM=JBND (L ) 

XTH=X ( JBNOM) 

JS2* JS1 ♦ 1  $ 


JS3  = 


s JS 1+2 

XSTDP=0.5*(XS(JS2) +XS(JS3) ) 

IF  (JS3  .EQ.  NPDINT)  XSTDP=XTH 

SET  UP  FOR  INTEGRATION  BY  SIMPSDNS  RULE.  SEMILDG  PARABOLA  IN 
LOG(E)*Zl*LOG(El) ♦Z2ttL0G(E2) *Z3*LDG(E3) 

WHERE  Z ( J) =-R ( I  ,  J) *R  ( J,K)  ANO  R ( I . J )  =  ( X-X ( K ) ) / ( X ( J ) -X ( I ) ) 
ES1«AL0G(AMAX1 ( ES ( JS1) .l.E-10) ) 


C00RDL05 
EQSTCC1M2 
EQSTC0M3 
EUSTC0M4 
EUSTCOMb 
EQSTCOMb 
EOSTCOM7 
EQSTCOMb 
EQSTCOM9 
2 

RAUCOM  3 
SSCOM  2 
SCATT021 
SCATT022 
SCATT023 
SCATT024 
SCATT025 
SCATT026 
SCATT027 
SC ATT02B 
SCATT029 
SCATT 030 
SCATT031 
SCATT032 
SCATT033 
SCATT034 
SCAT  T035 
SCATT036 
SCATT  037 
SCAT  T038 
SCATT039 
SCATT  040 
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SUBROUTINE  SCATTO  (Concluded) 


494 

495 


C 


496 


C 


500 


ES2=AL0G( AMftXl (ESI  JS2) tl.E-10) ) 

ES3*ALOG ( AMAX1 (ESIJS3) tl.E-10) ) 

XlsXS(JSl)  $  X2=XS(JS2)  $  DX 1 2=X2-X 1  $  X3=XS(JS3) 

DX 1 3*X  3-X 1  $  DX23*X3-X2 

R 1 2* (XEND-X3) /DX12  J  R23= ( XEND-Xl ) /DX23  1  R3 1  =- ( XEND-X2 ) /DX 1 3 

ESS1=EXP  (-ESl'tRl2»R31-ES2*R23«Rl2-ES3«R31»R23) 

XBEG*XEND 

XEND=AMIN1 (XSTOPtX ( J*1 ) ) 

Rl2= (XEND-X3) /DX12  $  R23= ( XEND-X 1 ) /DX23  S  R31 *- ( XEN0-X2 ) /OX  1 3 

ESS3=EXP(-ES1*R12*R31-ES2«>R23*R12-ES34‘H31<*R23) 

XM= (XeEG*XEND) /2. 

R 1  2s  (  XM  -X  3 )  /DX  1 2  $  R23*(XM  -X11/DX23  i  R31=-(XM  -X21/DXU 

ESS2*EXP(-ES1»R12*P31-ES2«*R23*R12-ES3«R31*R23) 
ESS=(XEND-XBEG)/6.*(ESS1+4.<*ESS2  +  ESS3)  ♦  ESS 
ESS1 =ESS3 

IF  (ABS(XEND-X(J*1) )  .LT.  l.E-10)  GO  TO  496 

PREPARE  FOR  NEW  SET  OF  THREE  XS  COORDINATE  POINTS 
IF  ( JS3  .LT.  NPOINT)  JS1=JS1+1 
GO  TO  492 
DX=X ( J* 1 ) -X ( J ) 

SS ( JFINNS+J) *ESS«FACTOR/DX 
ESUM=ESUM+ESS 

PREPARE  FOR  NEXT  PUFF  CELL 

IF  (XEND.GT •  XS ( NPOINT )  .AND.  ES(NPOINT)  .LE.  .01)  GOTO  500 
ESS  =  0 . 

J=J  +  1 

IF  (XEND  .LT.  XTH-i.E-10)  GO  TO  495 
M  =  JHAT(L) 

RETURN 

END 


SCATT041 
SCATT042 
SCAT  TU43 
SCATT  044 
SCATT  045 
SCATT  046 
SCATT047 
SCATT  048 
SCATT049 
SCATT050 
SCATT 051 
SCAT  T052 
SCATT 053 
SCATT054 
SCATT  055 
SCATT056 
SCATT  057 
SCATT056 
SCAT  T059 
SCATT  060 
SCATT061 
SCATT062 
S  C  A  T  T  0  b  3 
SCATT064 
SCATT  065 
SCATT066 
SCATT  067 
SCATTObB 
SCATT069 
SCATTC70 
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SUBROUTINE  SCRIBE 


SUBROUTINE  SCRIBE  SCRIBE  2 

INTEGER  H. POROUS. PRESS . R I NTER . SOL  1 0 . SPALL  PUFCOM  2 

REAL  MATL.NEM.NET.NEMH.NETH  PUFCOM  3 

MISCELLANEOUS  PUFCOM  4 

COMMON  AZERO(l) .CEF.CKS.OAVG.OELTIM.OISCPTUO) . OOLO * ORHO . OTM AX .  PUFCOM  5 

1  OTMIN. DTN.OTNH. DU. DX.EOLO.F. FAC. FIRST. J.JCYCS.JINIT.  PUFCOM  6 

2  JFIN. JREZON < 15) . JSMAX . JSTAR , JTS . LSUB < 30 ) ,M.MAXPR<30) .N.NCYCS.  PUFCOM  7 

3  NEDIT.NPERN.NR.NREZON.NSCRB (6) . NSEPH A T ♦ NSP ALL . NTEDT .  PUFCOM  8 

4  NTEX.NTR115) .POLO.P6I20) .R<30) .RLAST . SLAST . SMAX . TEOI T ( 50 ) »  PUFCOM  9 

5  TF.TIME.TJ.TREZON,TS.T6<20> tUL AST . UOLO » UZERO *  XL AST  * XNOW , XOLO  PUFCOMlo 

1  »XJOIT(20)  PUFCOM  1 1 

HALFSTEP  VALUES  PUFCOM 1 2 

COMMON  DH.OHLAST.OUH.EH.PH.RH.HHLAST.SH.SHLAST.UH.UHLAST.XH.XHLASTPUFCOM13 

1  .NEMH.NETH  PUFC0«*14 

CONDITION  INDICATORS  PUFC0M15 

COMMON  INF  * L INTER  *  MIRROR  *  NORMAL* POROUS  . PRESS . R INTER  * SOL  10.  SPALL  PUFCOM 16 

CELL  LAYOUT  PUFCOM17 

COMMON  DXX (30) . JBNO (30) . JMAT (30) .NAUTO.MATL (6.2) . NL A YER . NMTRLS ,  PUFCOM 18 

1  THK ( 30 )  PUFCOM  1 9 

PUFCOM20 

COORDINATE  ARRAYS  C00R0C02 

COMMON/COORD/X (200) ,X0(200) ,CHL(200) .OHH200) ,OPOO(200) .OPOE(200) .COOROCU3 
1  EHL  (200)  *  H ( 20  0  *  3 )  .NEM(200)  .NET  (200)  .PHL(200)  .RHH200)  .SOT  (2  00)  *  COOROCO4 


2  SHL (200) *T (200) *U (200) tYHL (200) .ZHL (200) 

C00R0C05 

COMMON/NSC/A (5000) 

NSCCOM  2 

COMMON  / JEO/ JEOI T ( 1 00 ) .JNUM(IOO) .JTYP(IOO) ,NAME2(40) .JEOSIZ. 

JEOCOm  2 

1  MOOLUS.NERR.NJEOIT.NTAPE 

JtOCUM  3 

OIMENSION  JV ( 13) 

SCRIBE  7 

NTAPE=3 

SCRIBE  8 

REWINO  7 

SCRIBE  9 

WRITE  (7)  N 

SCR  I  BE  1 0 

CALL  SECONO(XSTaRT) 

SCR  I  BE  1  1 

IF  (NERR  .GT.  0)  PRINT  1083. NERR 

SCR  I  Be.  1 2 

NSC* (NJEDIT*2)/10*1 

SCRIBE13 

NBUF=(N-l)/MOOLUS*l 

SCRIBE14 

NPERP=50/MODLUS 

SCRIBE  15 

c 

SCRIBE16 

c 

BEGIN  00  LOOP  OVER  EACH  SCRIBE  LISTING 

SCR  I  BE  1 7 

c 

SCR  1 8E 18 

DO  900  NS= 1 . NSC 

SCRIBE19 

LENGTH=MOOLUS 

SCRIBE20 

IPAG=1 

SCR IBE2 1 

IF  (UNIT (NTAPE) )  650*990.640 

SCRIBE22 

640 

PRINT  1082 

SCRIBL23 

REWINO  NTAPE 

SCRIBE24 

C 

SCRIBE25 

C 

BUFFER  IN  FIRST  RECORO  OF  TAPE 

SCRIBE26 

650 

BUFFER  IN  (NTAPE. 1)  ( A 1  •  A  1 ) 

SCRIBE27 

IF  (UNIT (NTAPE) )  655.990.652 

SCRIBE28 

652 

PRINT  1082 

SCRIBE29 

655 

BUFFER  IN  (NTAPE. 1)  (All) .A ( JEUS I Z^MOOLUS ) ) 

SCR1BE30 

IF  (NS  .GT.  1)  GO  TO  680 

SCRIBE31 

JENOaMINO < 12.NJE0IT+5) 

SCRIBE32 

J8EG=3 

SCRIBE33 

JV(l)=10H(0PF6,n. 

SCRIBE34 

J V ( 2 ) =1 OHF  10.3 

SCRIBE35 

JV(3)=10H,F10.3 

SCRIBE36 

JV (4) =10H.F10.3 

SCRIBE37 

JV(5)=10H.F6.0 

SCR1BE38 

JV ( 13) *  1  OH ) 

SCRIBE39 

00  670  1=1.7 

SCRIBF40 

JJ= I *5 

SCRIBE41 

JV(JJ)=10H.1PE11.3 

SCRIBE42 

IF  (JNUM(I)  .GE.  1400  .ANO.  JNUM ( I )  .LT.  2000)  J V ( J J ) =9H . 1 oX , A 1 

SCRIBL43 

IF  (I  .GT.  N JEOI T )  JV ( J J ) = 1 H 

SCRIBE44 

670 

CONTINUE 

SCRIBE45 

GO  TO  695 

SCRIBE46 

680 

JBEG* JENO* 1 

SCHIBE47 
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SUBROUTINE  SCRIBE  (Concluded) 


690 

695 


700 

710 


C 

750 

770 


850 

900 


990 

1082 

1083 

1084 
1100 


1200 

1900 


JEND=MIN0 ( JBEG*9»NJEDIT*5> 

JD= JBEG+9 
DO  690  I  *  JBEG  » JU 
JJ=I-JBEG*3 
JE=I-5 

JV(JJ)=I0H,IPE11.3 

IF  (JNUM(JE)  .GE.  1400  .AND.  JNUM(JE)  .LT.  2000) 

I  JV ( JJ> =9H. IOX. A1 
IF  (I  .GT.  NJEDI T  +5 )  JV(JJ)=1H 
CONTINUE 

DO  850  NB=1»NBUF 

IF  (UNIT (NTAPE) )  710*990*700 

PRINT  1082 

IF  (NB  .NE.  NBUF )  GO  TO  750 
IF  (MOD (N*MODLUS)  .EQ.  0)  GO  TO  770 
LENGTH=MOD (N.MODLUS) 

GO  TO  770 

BUFFER  IN  RECORDS 
JBUF=MOD (NB.2) «2500 

BUFFER  IN  (NTAPE. 1) ( A ( J6UF ♦ 1 ) , A ( JBUF +2500 ) ) 

CONTINUE 

Jl=MOD (NB-1 .2) "2500 
J2= (LENGTH-I ) 4JEDSIZ+ Jl 
JB= JBEG-5 
JD= JEND-5 

IF  ( I  PAG  .EG.  I  .AND.  NS  .GT.  1  )  PRINT  1 200 » D I SCPT , NS , ( JT YP ( I ) . 
1  I = JB . JD ) 

IF  ( I P AG  .EG.  I  .AND.  NS  .EQ.  1)  PRINT  1 1 00  * D I SCPT , NS , ( JTYP (  I  )  , 

1  I  =  1  *  JD ) 


SCR  I Bt48 
SCR  I BF  49 
SCRIBF50 
SCRIBE51 
SCRIBFS2 
SCHIBF53 
SCRIBES4 
SCRIBE55 
SCRIBE56 
SCRIBE57 
SCRIBE58 
SCR  I  Bt59 
SCR  I BF60 
SCRIBL61 
SCR  I BL  62 
SCR  I Bt  63 
SCR  I Bt 64 
SCR  I Bt 65 
SCR  I  BE b6 
SCR  I BF 6  7 
SCRIbc'68 
SCRIBE  69 
SCR  I Bt  70 
SCRIBE  7 1 
SCR  I Bt  72 
SCRIBE7J 
SCR  I Bt  74 
SCR  I bF75 
SCRIBE76 


PRINT  JV. ( (A(I*J) *1=1*2) * (A(I+J> * I=JBEG. JEND) * J= J 1 . J2 * JEDS I l ) 

IPAG=MOD ( IPAG.NPERP) *1 

CONTINUE 

REWIND  NTAPE 

CONTINUE 

CALL  SECOND(XEND) 

DUR=XEND-XSTART 
DUR2=XEND-FIRST 
PRINT  1900.DUR.DUR2 

return 

PRINT  1084 
RETURN 

FORMAT  (32H  PARITY  ERROR  ON  NTAPE  IN  SCRIBE) 

FORMAT  («  EOFS  AND  PARITY  ERRORS  ON  TAPE  3*  NERR  =*I3> 

FORMAT  (29H  EOF  FOUND  ON  NTAPE  IN  SCRIBE) 

FORMAT  (1H1.10A10/4  SCRIBE  NO.  4J2.4  USUAL  UNITS  ARE  DYN.  CM. 

1  GRAM,  EXCEPT  TIME  IN  MICROSEC,  DTNH  IN  NANOSEC*/ 

2  5X,4N*,6X,*TIME4,6X,4DTNH4,4X.4DELTIM»,3X,4JTS4,7 ( IX, AIO) ) 
FORMAT  ( 1H 1 » 1 0 A 1 0/4  SCRIBE  NO.  4i2,4  USUAL  UNITS  ARE  DYN.  CM. 

2  GRAM*/  5X»4N4,6X.*TIME4,10(1X,A10) ) 

FORMAT  (17H0TIME  IN  SCRIBE  =  F10.3/I7H  COMPUTING  TIME  =  Flo. 3 
END 


SCK 
SCR 
SCR 
SCR 
SCR 
SCR 
SCR 
SCR 
SCR 
SCR 
SCR 
SCR 
SCR 
SCR 
SCR 
SEC, SCR 
SCR 
SCR 
SEC  *  SCR 
SCR 
)  SCR 
SCR 


I  Bt  77 
I  Bt  78 
I  BF  79 
I  BF  8  0 
IBFbl 
IBE82 
IBt  83 

IBE84 
IBE65 
I B  t"  b  6 
IBE87 
IBE88 
I  Btb9 
IBF90 
IBE91 
IBE92 
I  bE93 
I6E94 
I  BE  95 
I BE96 
IBE97 
I  BE  98 
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SUBROUTINE  SHEAR 2 


SUBROUTINE  SHE AR2 (NCALL*IN,M,K,J, I H3 , SX , S Y , SZ , SX Y , P , T AU , DH , DOLD , 
lDTO,EH,EOLD*EN,FMELT*EP,EX,EY,EZ*EXY,F, YHL,PLEN,ROT*OROr,ESC*CN) 

ROUTINE  FOR  COMPUTATION  OF  STRESSES  WITH  RATE-DEPENDENT 
YIELD  MODEL  FOR  DEVIATORS  AND  M I E-GRUNE I  SEN  FOR  PRESSURE. 

IF  THRESHOLD  PLASTIC  STRAIN  IS  REACHED  *  SHEAR  BANDS  ARE 
NUCLEATED  AND  GROWN  IN  6  ORIENTATIONS. 

SX,  Sy*  SZ  ARE  DEVIATORS  IN  EXTERNAL  SIGN  CONVENTION. 

P  IS  POSITIVE  IN  COMPRESSION.  INTERNAL  SIGN  CONVENTION  IS 
POSITIVE  IN  COMPRESSION  FOR  ALL  STRESS  AND  STRAIN  QUANTITIES 
ST  IS  TOTAL  STRESS  AT  PREVIOUS  TIME.  SE  IS  NEW  DEVIATOR. 

EX*  EY.  EZ*  F.XY  ARE  STRAIN  INCREMENTS  IN  EXTERNAL  SIGN  CUN. 

SS*  SSE  CHANGF  EXTERNAL  SIGN  CONVENTION  TO  INTERNAL  FOR 
STRESS  AND  STRAIN,  RESPECTIVELY. 


SHEAR? 
SHE  AN? 
SHEAR? 
SHEAR? 
SHEAR? 
SHEAR? 
SHEAR? 
SHEAR? 
SHE AR? 1 0 
SHEAR? 1 1 
SHEaR?12 
SHEAR?1 3 
SHEAR? 1 4 
SHE AR? 1 5 


DIMENSION  BFR(6,35) *NSIZE(30*9) ,FNUC(9) , T AUZ ( 6 ) , EFR ( 3 ) , VFR ( 6 ) , 

SHEAR?  1  7 

1ST  (4)  *ES (4)  ,SE (4) *TEP (6) *ESC (6*20) *NSIZT (6) 

SHEAR? 1 8 

2  *CN(100>  *DEP(4>  *CLA(100>  *CNA(100) *  VMAX (6 ) 

SHEAR219 

EQUIVALENCE  (CNa*CLA) 

SHEAR220 

STRESS  IS  NEG  IN  TENSION 

SHEAR?? 1 

DATA  SS.SSE/-1 . ,-l ./ 

SHE AR222 

NCI =NCALL*  1 

SHEAR?? 3 

GO  TO  ( 1 0  *  1 0  *  1 00*  1 00*900 ) NCI 

SHE AR2?4 

1  0 

READ (IN, 1002)  A 1 , A2  *  (BFR  (M,  I )  ,  1=22,35) 

SHE AR?25 

PRINT  1002*  A1 *A2*  (BFR(M,I ) ,1=22*  35) 

SHE AR??6 

1002 

FORMAT (2A5*7El0.3/10X,7El0.3) 

SHEaR?27 

REAO ( IN, 1003) A1 ,A2, (NSIZE (M, I ) ,1=1 *9) 

SHEAR?2b 

PRINT  1003*A1*A2* (NSIZE (M, I) ,1=1*9) 

SHE ARc29 

1003 

FORMAT (2A5* 1415) 

SHE AR?30 

VMAX ( M ) =o . 

SHEaR?3 1 

NSIZT (M)=NSIZE(M*1) 

SHEAR?32 

DO  14  1=2*9 

SHEAR233 

14 

NS1 ZT (M) =NSIZT (M) +NSIZE (M, I ) 

SHE aR?34 

VFR (M) =1 . 

SHEAH?35 

IF  ( NC ALL  .EQ.  1)  GO  TO  65 

SHtAR?3b 

NANG=BFR (M,3?) 

SHEAR?37 

klast=o 

SHEAKc38 

DO  16  1=1,3 

SHEAR,- 39 

FNUC(I)=. 111111 

SHEAR?<*0 

16 

FNUC(I*3)=. 222222 

SHEAR?4 1 

IF (NANG  -  6)  20*40*30 

SHEaR?42 

20 

FNUCI=. 333333 

SHeaR?43 

IF  (NANG  .GE.4)  FNUCI  =.25 

SHEaR?44 

DO  25  1=1*4 

SHEAR?45 

25 

FNUC ( I ) =FNUC I 

SHEaR?46 

IF  (NANG  . EQ . 2 )  FNUC(2)  =.6666667 

SHEaR?47 

IF  (NANG  .NE.  5)  GO  TO  30 

She  A R ? 4 8 

FNUC ( 4 )  =  » 1 25 

S  H  E  A  R  ?  <*  9 

FNUC (7) =. 125 

SHE AK/50 

FNUC  (5) =0* 

SHE  AR?5 1 

FNUC (6) =0. 

SHE AR?52 

GO  TO  40 

SHEAR?5  3 

30 

DO  35  1=7, NANG 

SHEAR254 

FNUC  (I)  —  .111111 

SHE  AH?55 

35 

FNUC(I-3)=. 111111 

SHEAR  5b 

40 

CONTINUE 

SHE AR?57 

65 

RETURN 

SHE AR  ?58 

SHEAK^59 
SHE AR?bO 

COMPUTE  STRESS  AND  DAMAGE 

SHE AR2b 1 
SHE  AR?b2 

SHEaR?63 

100 

IF  (IH3  .GE.  25)  GO  TO  600 

SHE AR264 

IF  (VMAX(M)  .EQ.  0.)  VMAX (M) =SQRT (ESC (M,5) /ESC  (M,  1  ) ) 

SHE AR?65 

COMPUTE  STRESS  REDUCTION  FACTORS  TaUZ(I) 

SHE AR?b6 

tau=o. 

SHE AR?b  7 

JN  =  0 

SHEAR268 

DO  no  NG=  1  , N ANG 

SHEAR269 
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SUBROUTINE  SHEAR 2  (Continued) 


Tauz (NG) =o. 

IF (NSI ZE (M»NG)  .EQ.  0  .OR.  CN(JN*l)  .EQ.  0.)GO  TO  110 
NSIZEM=NSIZE(M,NG) 

Do  120  1  =  1  *  NSI ZFM 
JNNs JN  +  2* I  - 1 

120  TAUZ (NG) =TAUZ (NG) +CN ( JNN) *CN ( JNN  +  1 ) **3 
T  AU  =  T  AU  +  T  AUZ (NG) 

110  JN=JN+2*NSIZE(M,NG) 

«««»««««« 

INITIAL  TRANSFORMATION 
««««««««» 

ADJUST  SIGNS, ROTATE  STRESS , TRANSFORM  TO  STRESS  IN  SOLID(ST) 
RT=ROT+ROT+DROT 
EMU  =  DOLD/ESC (M, 1 ) -1 . 

Pri=EMU* (ESC (M,2> *EMU* (ESC (M,3) ♦ EMU* ESC (M,4) ) ) 

PS=PH* ( 1 .-ESC (M,9) "EMU/2. ) +DOLD*ESC ( M , 9 ) *EOLD 
I F ( PS  .GT.  0.)  P=P-PS*TAU 
SA=(SX*SY)*SS/2.+P 
SOR=S I N ( RT ) 

COR=COS ( RT ) 

SB=(  (SX-SY) /2.*COR+SXY*SOR) *SS 


SHE AR?  7  0 
SHE AR  2  7 1 
SHEAR272 
SHEAR273 
SHEAR?74 
SHEARP75 
SHEAR?  76 
SHEAR  2  7  7 
SHE ARc  78 
SHEAR279 
SHEAR2B0 
SHEAR201 
SHEAR2B2 
SHE  AR?t)3 
SHEAR284 
SHEAR?85 
SHEAR?86 
SHEARfH7 
SHE AR?B8 
SHEAR. 69 
SHE AR?90 


DO  140  1=1,4 

140  ST ( I ) =0 . 

G2=2.*ESC(M,5) 

ST ( 1 ) =  (SA*SB) /AMAXl  (0.02,  (  1 . - ( 3 . *T AUZ ( 1 ) ♦ 1 . 5*  <  TAUZ ( 4 ) ♦ T AUZ ( 5 )  ) 
1  *VFR(M)>> 

ST(2>=(SA-SB)/AMAX1<0.02*(1.-<3.*TAUZ<2>*1.5*(TAUZ(4>*TAUZ(6>>> 
1  * VFR ( M ) ) ) 

ST (3) = (P- (SX+SY) *SS) /AMAX1 ( 0.02, ( 1 . - ( 3 . *TAUZ ( 3 ) + 1 . 5* ( T AUZ ( 5 ) + 

1  TAUZ (6) ) >*VFR(m> ) ) 

ST (4) s ( (SY-SX) /2.*S0R  +  SXY*C0R) »SS/ ( 1 .- ( 1 .5* (TAUZ ( 1 ) ♦ T  A  U  Z ( 2 ) ) +3. 
1  *TAUZ (4) ) »VFR (M) ) 

IFIJ.EQ.  17  .AND.  TAU  ,GT.  0.05)  PRINT  1 400  .  SX ,  SY ,  SZ  *P  ,  ST  ,  EX  ,  E'Y 
1400  FORMAT ( 1  OH  SX,SY*SZ  =  3E10.3*3H  P  =  E10.3«4H  ST  =  4E10.3/7H  EX,EY  =  2E1 
1*4H  DH=F10.5) 

P= (ST ( 1 ) *ST (2) +ST (3) ) /3. 

:  rotate  strains  to  band  orientations 

EA= (EX+EY ) /2. 

EB= (EX-EY) /2.*COR*EXY*SOR 

EB A R= 0.6667* (DH-DOLD) / (DH+DOLD) 

NSTEP=SQRT( ( ABS ( E A ) ♦ ABS ( EB ) ♦ ABS ( EB AR ) J/.002) 

NSTEP=MAX0 (NSTEP, 1 ) 

ES ( 1 ) =  (EA+EB)»SSE /NSTEP 
ES ( 2 ) =  (EA-EB)*SSE/NSTEP 
ESI  3) =3.*EBAR/NSTEP-ES(1)-ES(2) 

ES (4) = ( ( (EY-EX) /2.*S0R*EXY*C0R) *SSE) /NSTEP 
DO  600  NS=1* NSTEP 
DO  160  1=1*3 

160  SE ( I ) =ST ( I ) +G2* (ES ( I ) -EBAR/NSTEP ) -P 
SE ( 4 ) =  ST ( 4 ) *G2*ES ( 4 ) 

SN=SQRT ( 1.5* (SE ( 1 ) **2*SE (2) **2+SE (3) **2*2.*SE (4) **2> ) 
DriN=DOLD+FLOAT (NS) /FLO AT ( NSTEP ) * ( DH-DOLD ) 

EMU=DHN/ESC (M, 1 ) -i . 

PH=EMU*(ESC(M,2) ♦EMU*(ESC(M.  3) +EMU*ESC (M,  4))) 

PE=PH* ( 1 .-ESC (M,  9 ) *EMU  /2. ) *DHN*ESC (M,  9>*EH 

Yl=AMAXi (0. *YHL*BFR (M,33) *PE) 

IF  (SN  .LT.  Yl)  GO  TO  500 


SHEAR2R2 
S  H  E  A  R  ?  9  3 
SHEAR294 
SHEAR295 
SHEAR296 
SHEAH297 
SnE AR29B 
SHEAR299 
SHE AR 1 0  0 
SHEAR  101 
DHSHE AR  102 
0 . 3SHE AR 1 03 
SHEAR  104 
SHE AR 1 05 
SHEAR  1 06 
SHEAR] 07 
SHEAR  108 
SHEAR  1 09 
SHEARl  10 
SHEAR  1  1  1 
SHEARl  12 
SHEARl 13 
SHEARl  14 
SHE AR  1 1 5 
SHE AR 1 1 6 
SHEARl  1  7 
SHE AR  1 1 8 
SHEAR119 
SHEAR  120 
SHEAR121 
SHEAR  122 
S  lEARl 23 
SHEAR  124 
SHEAR  125 
SHEAR  126 


C  YIELD  AND  PLASTIC  STRAIN  CALCULATIONS 

EXPT  =  EXP (-DTO/BFR (M, 30) /NSTEP) 

YEG= ( Y1*BFR ( M , 3 1 ) *SN/2./G2)/ ( 1 . +BFR ( M , 3 1 > /2./G2) /SN 
DO  180  1=1,3 

180  SE ( I )  =  (ST ( I ) -P) *EXPT* ( YEG*SE ( I ) ♦BFR  < M, 30 ) * ( SE ( I ) -ST ( I ) *P> / 
lDTO*NSTEP) * ( 1 .-EXPT ) 

SE(4)=ST (4)*EXPT*(YEG*SE(4)*BFR(M,30)*(SE(4)-ST (4) ) /UTO*NSTEP) * 
1  ( 1 . -EXPT ) 

DO  200  1=1*3 


shear  127 

SHE AR 1 28 
SHEAR  1 29 
SHEAR  130 
SHEAR131 
SHEARl 32 
SHE AR 133 
SHEAR  1 34 
SHEARl 35 
SHEAR  1 36 
SHEARl 37 
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SUBROUTINE  SHEAR2  (Continued) 


200  0EP(I ) sES( I) -EBaR/NSTEP- <SE ( I ) -ST ( I ) *P) /G2 
DEP(4)=ES(4)-(SF(4>-ST<4) )/G2 

DGAMMA=SQRT ( 1 .5*(DEP ( 1 ) **2*DEP (2) <**2*DEP (3) **2) *0.75*UEP (4) 
1**2) 

YHL  =  YHL  +  BFR  (M,3l ) *DG AMM A 

DPLENRb ( ( SE ( 1 ) *  ST ( 1 )-P) *DEP ( 1 ) ♦ <SE (2) *ST (2) -P) *DEP (2) ♦ ( SE (3) *S 
IT  (3)  -P)  *DEP (3) +  (SE  (4)  *ST  (4)  )  *DEP  (4)  )  /2  . /L)HN»  AMAX  1  (0.  *  1  .-TAU) 
DPLENR=ABS (DPLENR) 

EP=EP*DGAMMA 

plen=plen*dplenr 

C********** 

C  COMPUTE  PLASTIC  STRAIN  IN  EACH  ORIENTATION 

0********** 

STR1 =ABS  (SE  (4) ) 

STR2=ABS (SE (4) ) 

STR3=0. 

STR4=APS(SE(1)-SE(2) )/2. 

STR5=SQAT  (ISL( 11 ~5£ (3>  )*"?+2.*5E  rvl  **2>  72, 

STPfc“SQR  T  (  r  SE.  1  PI  -SE  (3  i  1-*2<-2.»SL  I4)*»2) 72. 

5N=SQRT  <l,5MSE<l)(t»2*3E(2!'t't2  +  5E(3]  ""Z+Z.^SE  (4)  **2)  ) 

TEP  ( 1 )  *PGAMMA/SN*STSl 
TEP (2) =0GAMMa/SN*STR2 
TEP (3) =DGAMMA/SN*STR3 
TEP ( 4 ) =D GAMMA/S NttSTR4 
TEP (5 ) =DGAMMA7SNttSTR5 
TEP  (6) =DGAMMA/SN*STR6 

C********** 

C  GROWTH  PROCESS 

C********** 

NTOT =2*NS I ZT (M) 

00  250  1  =  1  * NTOT 

250  CNa ( I ) =CN ( I ) 

IF  (EN  .EQ.  0)  GO  TO  360 
JN  =  o 

DC=VM AX ( M ) *DTO/NSTEP 
DO  350  NG= 1 . NANG 
DGAM=0 . 

IF  (NSIZE (M.NG)  .EQ.  0.  .OR.  CN(JN*1)  .EQ.  0  .OR.  TEP(NG)  .LE. 
1  GO  TO  345 

EXPE=EXP (BFR <M,22) <*TEP (NG) ) 

NS  I ZEM=NS I ZE  (M.NG) 

DO  300  I=1.NSIZFM 
JN2=JN+ 2* (NSIZE (M.NG) +1-1 ) 

CL A ( JN2 ) =AM I N 1  (CN ( JN2) *EXPE  »CN ( JN2) *OC) 

300  DGAM=DGAM.CN( JN2-1 ) *3 . 1 4*BFR ( M . 27 ) * ( CL A ( JN2 ) **3-CN ( JN2 ) **3 ) 

IF (DGAM  ,LE.  TEP(NG))GO  TO  345 

RR=TEP (NG) /OGAM 

DCR=DC*RR 

E  xPE=ExPE**RR 

NS  I ZEM  =  NS I ZE (M.NG) 

DO  340  1=1 .NS1ZFM 
JN2=JN*2* (NSIZE (M.NG) *1-1 ) 

340  CLA ( JN2) =AMINl ( CN ( JN2 > "EXPE . CN ( JN2 > ♦OCR > 

345  TEP (NG) =AMAX1 (0. . TEP ( NG ) -DGAM ) 

350  JN=JN*NSIZE (M.NG) *2 
360  CONTINUE 

DO  365  NG=1 . NANG 

365  CN ( NTOT *NG ) =CN( NTOT *NG) .TEP (NG) 

C  NUCLEAT ION  PROCESS 

C********** 

TEPM=0 

DO  370  NG=1.NANG 

370  TEPM=AMAX1 (TEPM.CN (NTOT*NG) ) 

IF  (TEPM  ,LT.  bFR ( M , 26 ) )  GO  TO  500 
JN  =  0 

DO  450  NG= 1 .NANG 

IF  (NSIZE (M.NG)  .EQ.  0)  GO  TO  450 


SHEAR  l  38 
SHE  AR 1 39 
SHEAR  140 
SHEAR  141 
SHEAR142 

SHE  AR 1 43 
SHE AR 1 44 
SHEAR  1 45 
SHEARl 46 
SHEAR  147 
SHEARl 48 

shear i 49 

SHEARl so 
SHEARl 5 1 
SHEAR] 52 

shear  1 53 

SHEAR  1 54 
SHEAR  1 55 
SHEAR] 56 
SHEAR  1 57 
SHEAR  158 
SHE  AR 1 59 
SHEAR  1 60 
SHEAR  1  fa  1 
SHEAR  162 
SHEAR  1 63 
SHEAR  1 64 
SHEAR  165 
SHEAR  1 66 
SHE AR 1 67 
SHEARl b8 
SHEAR  1 69 
SHE  AR 1 7  0 
SHEARl 71 
SHEAR  172 
SHEAR] 73 
SHEAR  1 74 
0. ) SHEARl 75 
SHEARl 76 
shear  1 77 
SHEARl 78 
SHEARl 79 
SHEAR180 
SHEAR  181 
SHE AR 1 82 
SHEARl 83 
SHE AR1 84 
SHFAR185 
SHEAR  186 
SHEARl 87 
SHF  AR 1 88 
SHEAR  1 69 
SHEAR  1 90 
SHEARl 91 
ShEARl 92 
SHE AR 1 93 
SHEARl 94 
SHE AR 1 95 
shear  1 96 
SHEAR197 
SHE AR 1 98 
SHE AR 1 99 
SHEAR200 
SHEAR201 
SHEAR202 
SHEAR203 
ShE AR204 
SHE AR205 
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SUBROUTINE  SHEAR 2  (Continued) 


IF  ( CN ( NTOT+NG)  .LT.  BFR(M,26)  .OR.  TEP  ( NG )  ,LT.  l.E-5) 

1  GO  TO  450 

DNOsTEP (NG) *BFR (M.25) »FNUC (NG) » ( DPLENR/DTO*NSTEP/BFR ( M , 35 ) ) **2 

CNR=0. 

NSIZEM=NSIZE (M.MG) 

DO  440  1=1 ,  NS  I ZEM 
I  I =NS I ZE (M  t NG) +1-1 
JN I = JN  +  2*  1 1 

I F ( CL A ( JN I )  ,NE.  0.)  GO  TO  420 

CL A ( JNI ) =BFR(M.28) * ( 1 . -BFR ( M . 29 ) I I ) / ( 1 . -BFR ( M , 29 ) »«NS I ZE ( M , NG ) ) 
CN ( JN I ) =CLA ( JNI ) 

420  CNL=DNO*EXP(-(CLA(JNI)*CN(JNI) ) /2 . /BFR ( M , 24 ) ) 

JNN=JN*2*I 1-1 


SHtAR?0b 
SHE  AH?0  7 
SHtARtOB 
SHEAR209 
SHEAR21  0 
SHEAR?  1 1 
SHLAR212 
SHt AH  t  1  3 
SHEAR2 1 4 
ShE AR2 1 5 
SHEAR? 1 6 
SHE AR?  1  7 
SHEAR?  1 8 


CNA ( JNN) =CNL-CNP+CN ( JNN) 

440  CNR=CNL 
EN=EN*CNL 

450  JN=NSIZE(M,NG)#2*JN 
470  CONTINUE 

C  COMPUTE  TAU  AND  REFILL  MAIN  ARRAYS 

tau=o. 

JN  =  0 

IF ( E N  .EQ.  0.)  GO  TO  500 
DO  490  NG=1.NaNG 
TflUZ (NG) =0. 

IF  (NSIZE(M.NG)  .EQ.  o)  GO  TO  490 
IF  ( CN A ( JN* 1 )  .EQ.  o.)  GO  TO  490 
NS  1 7EM  =  NSI ZE  (M.NG) 

DO  480  1  =  1  » NS  I ZEM 


SHt AR? 1 9 
SHEAR220 
SHEAR221 
SHE AR?22 
SHE AN  2?3 
SHE AR?24 
SHE AR?25 
SHE AR?26 
SHEAR?? 7 
SHE AR?2h 
SHE AR??9 
SHEAN?30 
SHt AR?3 1 
SHE aR?32 
ShEaR?33 
SHEAH?34 
SHEAN?35 


JNN=JN*2*I-1 


SHE A R? 3b 


CN ( JNN*1 ) =CL A (JNN* 1 ) 

CN( JNN)*CNA( JNN) 

480  TAUZ (NG) =TAUZ (NG) *CNA ( JNN ) *CL A ( JNN*1)  <»*3 
TAU=TAU*TAUZ (NG) 

490  JN=JN*NSIZE (M.NG) *2 

IF (TAU«VFR (M)  .GE.  1.)  GO  TO  800 
500  CONTINUE 
P  =  PE 

DO  550  1=1*3 
550  ST ( I ) =SE ( I ) *P 
ST(4)=SE(4) 

600  CONTINUE 


SHt AN??  7 
SHE AH?38 
SHE AR?39 
ShE AR240 
SHF.AR241 
SHEAR242 
SHEAN243 
SHEAR244 
SHEAHC45 
ShEAR24b 
SHE AR?47 
SHEAR248 


C  TRANSFORMATION  TO  GLOBAL  ORIENTATION 

C******«*** 

IF ( J  .EQ.  17  .AND.  TAU  .GT.  .05)  PRINT  1601, ST, P 
1601  FORMATUH  ST=  1P4E10.3*4H  PS=  E10.3) 


SHEAR?49 
SHE AR2B0 
SHEAR251 
SHEAR252 
SHEAR253 


ST (4) =ST (4) »AMAX1 ( 0. * ( 1 . - ( 1 .5* ( TAUZ ( 1 ) *T AUZ ( 2 ) ) *3 . *T AUZ ( 4 ) ) »VFR (M) SHEAR254 
1  > )  SHEAR?55 

ST ( 1 ) =  S  T ( 1 ) *AMAX 1 (0.* ( 1 .- (3.*TAUZ ( 1 ) ♦ 1 .5* (T AUZ ( 4 ) ♦ TAUZ (5) ) ) * VFR ( M ) SHt AR?5b 
1  >  >  SHEAR257 

ST ( 2 ) =ST (2) *AMAX1 (0. * < 1 . - ( 3 . °T AUZ  < 2 ) ♦ 1 . 5* < T AUZ  < 4 ) ♦ TAUZ ( 6 ) ) ) *VFR (M) SMtAR?5S 
1  )  )  SHEAR259 

ST (3)  =ST (3) *AMAxl ( 0. , ( 1 . - ( 3 . * TAUZ ( 3 ) ♦ 1 . 5* ( T AUZ ( 5 ) *TAUZ (6) ) ) * VFk ( M ) SHE AR260 


1  ))  SHEAR261 

P= ( ST ( 1 ) *ST (2) *ST (3) ) /3.  SHEAR262 


SA= (ST ( 1 ) *ST (2) ) /2. 

SB= (ST ( 1 ) -ST (2) ) /2.*COR-ST (4) *SOR 

SXY=( (ST ( l ) -ST (2 ) ) /2.*SOR*ST (4) *COR) *SS 

SX=(SA*SB-P)*SS 

SY=(SA-SB-P)»SS 

SZ=(ST(3)-P)«SS 

IF  (PE  .GT.  0.)  P=P*PE«TAU 

IH3=20.°TAU*2.9 

I F ( J  .EQ.  17  .AND.  TAU  .GT.  .05)  PRINT 

IF  ( NCALL  .GE.  3)  GO  TO  900 

RETURN 


SHEAR263 
SHE AR?64 
SHEAR265 
SHE AH?66 
SHEAR?b7 
SHE AR?68 
SHEAR?69 
SHEAR270 

1400 ,SX,SY,SZ*P,ST,EX,EY*DHSHEAR?71 

SHt AR?72 
SHEAR273 
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SUBROUTINE  SHEAR2  (Concluded) 


Q ««««« «««  -ft  O 

C  COMPLETE  SEPARATION 

C # «««««« «« « 

800  EMU=DH/ESC ( M  * 1 ) -1 • 

PH=EMU° (ESC (M.2) +  EMU* (ESC (M*  3 ) +EMU°ESC ( M .  4)1) 

PE=PH° ( l.-ESC (M,  9) * (DH/ESC (M, 1 ) -1 . ) /2. ) +OH»ESC (M.  9)°EH 
P  =  AMAX 1 ( PE  *  0 • ) 

SX  *  0  • 

SY  =  0. 

SZ  =  0. 

S  X Y  =  0 • 

IH3=25 

IF  (NCALL  ,GE.  3)  GO  TO  900 
RETURN 
«  «  «  «  « 

PRINT  DAMAGE  ARRAYS 

e  ■»  #  o  o 
900  IF  <EN  . EU.  0.)  GO  TO  980 
IF  (K  ,LT.  KLAST)  REWIND  2 
KLAST=K 

PRINT  8000.K.J.IH3.ROT.EN.TAU.EP 
JN  =  0 

DO  1  000  NG  =  1  *  N ANG 
T  AUZ (NG ) =0 . 

NS=NS I ZE (MtNG) *2 

IF  (NS  .EQ.  0  .OR.  CNIJN+l)  ,EQ.  0.1GO  TO  1000 
I  I = JN+NS” 1 
CNA(II)=CN(II) 

TAU2(NG)sCN(II)*CN(II+l)**3 
IF  (NS  . LE •  2)  GO  TO  975 
DO  970  1=3. NS. 2 
I  I =NS- 1 +  JN 

TAuZ (NG) =TAuZ (NG) +  CN ( 1 1 ) °CN ( 1 1  +  1 ) **3 
970  CNA(II)=CN(II)+CNA(II+2) 

975  CONTINUE 

PRINT  8500. NG 

PRINT  9001 ♦ (CNA ( JN  + I ) ♦ 1=1 »NS»2) 

PRINT  9002. (CNIJN+I) .1=2. NS. 2) 

WRITE  (2.1902)  J.K.NG 

WRITE  (2.9001)  (CN ( JN*I ) ♦ 1=1 .NS.2) 

WRITE  (2.9002)  (CNIJN+I) »I=2.NS.2) 

1902  FORMAT ( 1 J  =  .I10.10H  K=  .110. 10H  NG=  .110) 

8000  F0RMATI3H  K=I5.3H  J=I5.5H  IH3=I5.5H  ROT=El0.3»4H  EN=El0.3. 

1  5H  T  AU=E 1 0 • 3  *  4H  EP=E10.3) 

6500  FORMAT (4H  NG=I5) 

9001  Format ( 4H  cn=io (Eio.3.2x) ) 

9002  FORMAT ( 4H  CL= 1 0 ( E 1 0 . 3 . 2X ) ) 

1000  JN= JN+NS 

PRINT  1980. (TAUZ (I) . 1=1 .NANG) 

1980  FORMAT  <6H  TAUZ=  9F10.6) 

NTOT  =  2°NSIZT  <M) 

980  PRINT  9003. K. J. EP. (CNINTOT+I ) .1=1. NANG) 

9003  FORMAT!0  K=°I3.°  J=°I3.°  EP=°  E12.4.16H  TOT  PL  STRAIN  =6Fl0.3) 

return 

end 


SHEAH^  7 4 
SHEAR  275 
SHEAR? 78 
SHEAR277 
SHEAR  2  78 
SHE AH  2 79 
SrlEARc  80 
SHEAR281 
SHEAR282 
SHEAR, 83 
SHEAH;  84 
SHEAR^bb 
SHEAR^86 
SHEAR?8  7 
SHEAR. bfi 
SHEA  R  2  8  9 
SHEAK290 
SHE AK?H 1 
SHEAR292 
SHEAH893 
SHE AR  ?94 
SHE ARc95 
SHE AR  296 
SHE AR297 
SHE AR?9ri 
SHEAR 299 
SnEARSUO 
SHEAR301 
SHEAR j02 
SHE  AR  3  03 
SHEAR  304 
SHEAR  305 
SHEAR  30b 
SHE  AR.3U7 
SHEAR  308 
SHEAR  +09 
SHEAR310 
SHEAR311 
SHEARS  1 2 
SHE AR  3 1 3 
SHEARj 14 
SHEAR  315 
SHEARS  1 6 
SHEAR  317 
SHE AR3 1 8 
SHE  AR3  1  9 
SHEAK320 
SHEAR321 
SHE AR  322 
SHEAR 3 23 
SHEAR324 
SHEAR  325 
SHE AR  326 
SHE AR  32  7 
SHEAR  328 
SHEAR  329 
SHE AR330 
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SUBROUTINE  SIGMAT 


FUNCTION  SIGMAT(LS.T)  SIGMAT  2 
DIMENSION  PS  CIO) *TS (10)  SIGMAT  3 
DATA  PS/54.4E6,34.0E6,40.8E6,24.5E6,6#0./  SIGMAT  4 
DATA  TS/0. *6.E-4*8.E-4*3«2E-3*6*0./  SIGMAT  5 
DATA  NM/4/  SIGMAT  6 
Ns  I  SIGMAT  7 
N*N* 1  SIGMAT  8 
IF  (  T  .GT.  TS ( N )  • AND*  N  .LT.  NM)  GO  TO  20  SIGMAT  9 
SIGMAT=PS(N-1 ) ♦ (PS(N)-PS(N-J ) ) / (TS ( N ) -TS (N-l ) ) *(T-TS (N-I ) )  SIGMAT 10 
RETURN  SIGMATII 
END  SIGMAT 12 


r>  r>  n  n 


SUBROUTINE  SSCALH 


C 

10 


FUNCTION  SSCALH(JS) 

COMPUTES  PADIANJ  ENERGY  FOR  DEPOSITION  IN  EACH  CELL  AT  HALFSTEP 

PDINT  AND  INITIALIZES  ENERGY  IN  NEW  ZONES 

INPUT  -  J(=JS)»  NSPEC «  SDURM  *  TIME*  DTNH «  SSTOPM,  DTN. 

DUTPUT  -  SSCALH. 


INTEGER  H, POROUS. PRESS. R INTER, SOL  10, SPALL 
REAL  MATL.NEM.NET.NEMH.NETH 
MISCELLANEOUS 

COMMON  AZERO(l)  ,CEF , CKS , D A VG , DELT IM , 0 1 SCPT ( 1 0 )  , OOLD , ORHO , OTMAX , 

1  DTMIN.DTN.DTNH.DU.DX.EDLD.F.FAC.FIRST, j, jcycs, jinit, 

2  JFIN. JREZON (15) » JSMAX » JSTAR » JTS » LSUB ( 30 ) , M . MAXPR ( 3o ) » N , NC YCS . 

3  NEDIT , NPERN»NR»NREZ0N»NSCRB(6) » NSEPRA T » NSP ALL » NTEDT , 

4  NTEX »  NTR (15)  »POLD,P6(20)  »R(30) ,RLAS T , SLAST , SMAX , TEOI T (SO ) » 

5  TF.TIME.TJ, TREZON.TS.T6 (20) , ULAST ,UOLO .UZERD » XLAST , XNOW , XOLO 
1  »X JDIT  (20 ) 

HALFSTEP  VALUES 

COMMDN  0H,0HLAST»0UH,EH.PH,RH,RHLAST.SH,SHLAST»UH,UHLAST,XH»XHLASTPUFC0^13 
1  .NEMH.NETH  PUF  COM  1 4 

CONDITION  INDICATORS  PUFC0H15 

INF  »L INTER, MIRRDR.NDRMAL .PDROUS. PRESS »R INTER .SOL ID, SPALL  PUFCOM] 6 
CELL  LAYOUT  PuFCOm 1 7 

COMMON  DXX (30) , JBNO (30) , JMAT (30)  , N AUTO , MATL ( 6 , 2 )  , NL A YER , NMTRLS ,  PUFCO^lB 

1  THK  ( 30 )  PUFC0M9 

PUF  CO'-20 

SSTOP ( 5 ) .START (5) » SDURM , SSTOPM , NSPEC » SSJ , JSS , I  PLOT  <4)RA0C0M  2 


SSCALh 
SSCALH 
SSCALH 
SSCALH 
SSCALH 
SSCALH 
SSCALH 
PUFCOM 
PUFCOH 
PUFCOm 
PUFCOH 
PUFCO'1 
P  U  F  C  0 
PUFCOm 
PUFCOM 
PUF  COM  1 0 
PUFCOMl 1 
PUFC0M12 


COMMDN 


COMMON  /RAD/ 


46 

48 

C 

50 


60 

75 


1  » XMAX ( 4 ) »  XM I N ( 4 )  » YMAX ( 4 ) , YM I N ( 4 )  ,  I A  (  7 )  ,  I  TITLE  (24)  .NaRZ.TARZ 

COMMON/SS/SS (500) 

SSCALH=0. 

IF  (NSPEC  •  EO .  0)  RETURN 
IF  (JS  .GT.  JSS)  GD  TO  50 
IF  (SOURM  . EO •  1.)  RETURN 

IF  (TIME-DTNH-.5*DTN  ,GT.  SSTDPM)  RETURN 

ENERGY  ADDITION  IN  ACTIVE  ZONES  -  HALF  STEP 
DO  48  1=1 .NSPEC 
JFINNS=JFIN*(I-i> 

IF  ( (TIME-.5*0TNH-START ( I ) ) * ( T I ME-DTNH- . 5*0TN-SSTDP ( I ) ) )  46.48,48 
SSCALH=SSCALH*SS ( JFINNS  +  JS) * (AMIN1 (SSTOP (I)  » T I  ME- • 5*DTNH ) - 
1  AMAX 1 (START ( I ) , T I ME-DTNH- . 5*0TN ) ) 

CONTINUE 

RETURN 

ENERGY  ADDITION  FDR  NEW  ZONES 

JSS=JS 

DO  60  I  =  1 » NSPEC 
JF I NNS= JF IN* ( 1-1 ) 

IF  (TIME-.5*DTNh  .LT.  ST  ART ( I ) )  GO  TO  60 

SSCALH*SSCALH+SS (JFINNS+JS )*(AMIN1 (SSTDP ( I ) , T IME- . 5»DTNH ) - 
1  START ( I ) ) 

CONTINUE 

RETURN 

END 


RAUCOM  3 
SSCUM  2 
SSCALh 12 
SSCALh 1 3 
SSCALH 14 
SSCALH 1 5 
SSCALH 1 b 
SSCALH1 7 
SSC ALhI 8 
SSCALH 1 9 
SSCALH20 
SSCALH21 
SSCALH22 
SSLALH23 
SSCALH24 
SSCALh? 5 
SSCALh26 
S3CALh27 
SSC ALh28 
SSCALH29 
SSCAL-‘30 
SSCALm31 
SSCALH32 
SSCALH33 
SSCALH34 
SSCALh35 
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SUBROUTINE  STORR 


o 


0 


50 


SUBROUTINE  STORR 

I NTEGER  Hj POROUS, PRESS, R I NTER , SOLI D, SPALL 
REAL  MATL, NEM, NET, NEMH, NETH 
MISCELLANEOUS 

COMMON  AZEROC 1 ) , CEF, CKS, DAVG, DELTIM, DISCPT( 10)  ,  DOLD,  DRHO,  DTMAX, 

1  DTM I N , DTN, DTNH, DU, DX, EOLD, F, FAC, FIRST, J, JCYCS, J I NI T, 

2 

3 

4 

5 
1 


JF I N , JREZON (15), JSMAX , JSTAR, JTS , LSUB ( 30 ) , M , MAXPR ( 30 ) ,  N , NCYCS , 
NEDI T, NPERN, NR, NREZON , NSCRB (6) , NSEPRAT , NSPALL , NTEDT , 

NTEX , NTR (15), POLD, P6( 20 ) , R ( 30 ) , RLAST, SLAST, SMAX,  TED  I T( 50)  , 

TF , TIME, TJ , TREZON, TS, T6( 20) , ULAST, UOLD, UZERO, XLAST, XNOW, XOLD 
, XJD I T ( 20) , MS 


HALFSTEP  VALUES 

COMMON  DH, DHLAST, DUH, EH, PH, RH, RHLAST, SH, SHLAST, UH, UHLAST, XH, XHLAST 


STORR 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 

PUFCOM 


100 


2 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1  1 
12 
1  3 


200 


, NEMH, NETH 

PUFCOM 

14 

CONDITION  INDICATORS 

PUFCOM 

15 

COMMON  I NF, LI NTER, MI RROR, NORMAL, POROUS, PRESS, R I NTER, SOLI D, SPALL 

PUFCOM 

1  6 

CELL  LAYOUT 

PUFCOM 

1  7 

COMMON  DXX ( 30) , JBND(30) , JMAT(30) , NAUTO , MATL ( 6, 2 ) , NLAYER, NMTRLS, 

PUFCOM 

18 

THK ( 30 ) 

PUFCOM 

19 

PUFCOM 

20 

COORDINATE  ARRAYS 

COORDCOM 

2 

COMMON/ COO RD/X ( 200 ) , X0( 200 ) , CHL( 200) , DHL( 200) , DPDD ( 200)  ,  DPDEC200)  , 

COORDCOM 

3 

EHL ( 200 ) , H ( 200 , 3 ) , NEM (200) , NET ( 200) , PHL(200) , RHL ( 200 ) , SDT ( 200 ) , 

COORDCOM 

4 

>  SHL ( 200 ) , T(200) , U(200) ,YHL(200)  ,  ZHLC200) 

COORDCOM 

5 

COMMON/ NSC /A ( 5000) 

NSCCOM 

2 

COMMON  /IND/  I  EOS ( 6) ,  I NDK ( 20 ) , N ALPHA, NCMP ( 6) , NFR ( 6 ) , NPOR ( 6 )  , 

INDCOM 

2 

NDS ( 6 ) , NPR ( 6 ) , NCON ( 6 ) , NVAR(6) 

INDCOM 

3 

COMMON  /JED/ JED I T( 100), JNUM( 1 00) , JTYP( 1 00) , NAME2C 40) , JEDSI Z, 

JEDCOM 

2 

MODLUS, NERR, NJEDI T, NTAPE 

JEDCOM 

3 

COMMON  /PES/  LVMAX, LVTOT, LVAR( 200) , COM (4000) 

STORR 

8 

DIMENSION  R I MP ( 20 ) , J I  NT ( 20 ) 

STORR 

9 

DIMENSION  KB ( 300 ) 

STORR 

10 

EQUIVALENCE  (A( 2501), KB) 

STORR 

1  1 

IF  (N  .GT.  1 )  GO  TO  100 

STORR 

12 

INITIALIZATION 

STORR 

1  3 

NTAPE=3  $  NERR® I BUF  =  0  $  M0DLUS»50 

STORR 

14 

IF  (NJEDIT  .GT.  45)  M0DLUS=25 

STORR 

15 

IF  (NJEDIT  .GT.  95)  M0DLUS=10 

STORR 

1  6 

IF  (NJEDIT  .GT.  245)  M0DLUS=5 

STORR 

1  7 

JEDSI Z®2500/M0DLUS 

STORR 

1  8 

DO  30  1=1,10 

STORR 

1  9 

A ( 2500+ I ) =D I SCPT ( I ) 

STORR 

20 

KB (11) =MODLUS 

STORR 

21 

KB (12) = JEDS I Z 

STORR 

22 

KB ( 1 3) = JCYCS 

STORR 

23 

KB (14) =NJED I T 

STORR 

24 

DO  40  1=1,100 

STORR 

25 

KB( 14+1 ) = JTYP ( I ) 

STORR 

26 

KB( 1 14+1 ) = JNUM ( I ) 

STORR 

27 

BUFFER  OUT ( NTAPE, 1 )  ( A ( 2501 ) , A( 271 4 ) ) 

STORR 

28 

DO  50  1=1,20 

STORR 

29 

J I NT( I  ) = JED  I T ( I ) 

STORR 

30 

RIMPC I ) =0 . 

STORR 

31 

STORR 

32 

BEGIN  STORAGE 

STORR 

33 

IF  ( LSUB ( 7 )  .NE.  0)  GO  TO  600 

STORR 

34 

I B= JEDS I Z# I BUF 

STORR 

35 

A ( IB+1 )=N 

STORR 

36 

A ( I B+2) =TIME*1 . E6 

STORR 

37 

A ( I B+3) =DTNH# 1 . E9 

STORR 

38 

A ( I B+4 ) =DELT I M 

STORR 

39 

A ( I B+5 ) = JTS 

STORR 

40 

I C= I B+5 

STORR 

41 

I  R  =  0 

STORR 

42 

DO  500  JE= 1 , NJEDIT 

STORR 

43 

JD  =  JED  I T ( JE ) 

STORR 

44 

J NUMB* JNUM ( JE ) 

STORR 

45 

IF  ( JNUMB  .GE.  4000  )  GOTO  200 

STORR 

46 

STORAGE  FOR  ALL  ARRAY  VARIABLES 

STORR 

47 

A ( I C+JE) *X ( JNUMB+ JD ) 

STORR 

48 

GO  TO  500 

STORR 

49 

STORAGE  FOR  COM  VARIABLES 

STORR 

50 

IF  (JNUMB  .GE.  5000)  GO  TO  300 

STORR 

51 

JN= JNUMB -4000 

STORR 

52 

L=LVAR( JD) 

STORR 

53 
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SUBROUTINE  STORR  (Concluded) 


A ( I C+JE ) =  COM( L+JN ) 

GO  TO  300 

300  JB a J NUMB/ 200 -24 

IF  (JB  .GT.  8)  GO  TO  300 

GO  TO  (310,  320, 330 j  340, 350 j  360, 370,  380 )  JB 
INTERFACE  STRESS 
10  JD  =  J I  NT ( JE ) 

A ( I C+JE ) =  R  ( JD+1 ) 

GO  TO  300 

C  SECOND  PRINCIPAL  STRESS 

320  IF  (NALPHA  . EQ .  2)  GO  TO  323 

A ( I C+JE ) = -0 . 5#SHL ( JD ) + 1 . 5*PHL( JD) 

GO  TO  500 

323  A ( I C+JE) =PHL( JD ) +SDT ( JD ) 

GO  TO  500 

C  THIRD  PRINCIPAL  STRESS 

330  IF  (NALPHA  .EQ.2)  GO  TO  333 

A ( I C+JE ) = -0 . 5*SHL ( JD ) + 1 . 5*PHL ( JD ) 

GO  TO  500 

333  A( I C+JE ) = -SHL( JD ) +2 . *PHL ( JD ) -SDT ( JD ) 

GO  TO  300 
C  IMPULSE 

340  I R= I R+ 1 

R I MP ( I R ) =  R I MP ( I R ) +RHL( JD) #DTNH 
A ( I C+JE )  =  RI MP ( IR) 

GO  TO  500 

C  SPECIFIC  VOLUME 

330  IF  ( DHL ( JD )  .  GT  .  0.)  A ( I C+JE) - 1 . /DHL ( JD ) 

GO  TO  300 

C  DEVIATOR  STRESS  -  FIRST  DIRECTION 

360  AC  I C+JE) =SHL( JD ) -PHL( JD) 

GO  TO  500 

C  DEVIATOR  STRESS  -  SECOND  DIRECTION 

370  IF  (NALPHA  .EQ.  2)  GO  TO  375 

A ( I C+JE ) =0.3#(PHL(JD)-SHL(JD) ) 

GO  TO  500 

373  A ( I C+JE) =SDT ( JD ) 

GO  TO  300 

C  DEVIATOR  STRESS  -  THIRD  DIRECTION 

380  IF  (NALPHA  . EQ .  2)  GO  TO  385 

A ( I C+JE) =0.5#(PHL(JD) -SHL( JD) ) 

GO  TO  500 

383  A ( I C+JE) =PHL( JD ) -SHL( JD ) -SDT ( JD ) 

GO  TO  300 
300  CONTINUE 

I BUF= I BUF+1 

C  BUFFER  OUT  ARRAY  ONTO  NTAPE 

IF  ( I BUF  . NE .  MODLUS)  GO  TO  330 
305  IF  ( UNI T ( NTAPE) )  520,510,510 
510  NERR=NERR+1 

520  BUFFER  OUT ( NTAPE, 1 ) ( A ( 1 ) , A ( JEDS I Z*MODLUS ) ) 

IF  ( LSUBC  7 )  .NE.  0)  GO  TO  613 
RETURN 

550  IF  (I BUF  .NE.  2*M0DLUS)  RETURN 
533  IF  ( UNI T ( NTAPE) )  570,360,560 
560  NERR=NERR+1 

370  BUFFER  OUT ( NTAPE, 1 ) ( A( JEDSI Z*M0DLUS+1 ),A(3000)) 
I BUF=0 

IF  (LSUBC 7)  .NE.  0)  GO  TO  615 
RETURN 

600  IF  (I BUF  .EQ.  0)  GO  TO  613 

IF  ( IBUF-MODLUS)  303,615,333 
613  IF  ( UNI T( NTAPE) )  625,620,620 
620  NERR=NERR+1 
623  REWIND  NTAPE 
RETURN 
END 


STORR 

34 

STORR 

33 

STORR 

36 

STORR 

37 

STORR 

38 

STORR 

59 

STORR 

60 

STORR 

61 

STORR 

62 

STORR 

63 

STORR 

64 

STORR 

63 

STORR 

66 

STORR 

67 

STORR 

68 

STORR 

69 

STORR 

70 

STORR 

71 

STORR 

72 

STORR 

73 

STORR 

74 

STORR 

75 

STORR 

76 

STORR 

77 

STORR 

78 

STORR 

79 

STORR 

80 

STORR 

81 

STORR 

82 

STORR 

83 

STORR 

84 

STORR 

85 

STORR 

86 

STORR 

87 

STORR 

88 

STORR 

89 

STORR 

90 

STORR 

91 

STORR 

92 

STORR 

93 

STORR 

94 

STORR 

95 

STORR 

96 

STORR 

97 

STORR 

98 

STORR 

99 

STORR 

100 

STORR 

101 

STORR 

102 

STORR 

103 

STORR 

104 

STORR 

105 

STORR 

106 

STORR 

107 

STORR 

108 

STORR 

109 

STORR 

1  10 

STORR 

1  1  1 

STORR 

1  12 

STORR 

1  13 

STORR 

1  14 

STORR 

1  15 

STORR 

1  16 

STORR 

1  17 

STORR 

118 

STORR 

1  19 

STORR 

120 
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SUBROUTINE  STRES2 


SUBROUTINE  STRES2 (LS, IND, IH3.M, J.N.O.DOLO.RHOS.SDH.MUM.F .DTNPl .NEMSTRES2 
1  *NET  »TSR>  STRESS 

REAL  MUMtNEM.NET  STRESS 

COMMON  /S2/  ALF.CO.EEN. EENPl .FPN.KS.TAUEL.TAUI .TAUN.TAUO. VELS. VMU. ALCOM 


1  Z AM, Z AMUS V, ZEP. ZEPDSV, ZEPMAXC, ZEPMAXS, ZEPS A VE.ZTAUY.ZTAUYMX 
DIMENSION  TAUY (300)  .TAUYMX  (300>  .EPMAXS (300)  .EPMAXC (300)  * 

1  EPDSV  (  300  )  .  EPSAVE  (300)  .AMUSVOOO)  .EP(300>  »TAU<300> 

DIMENSION  TSR ( 6 , 30 ) 


VALUE  OF  IND  - 


0  COMPLETE  CALCULATION 

1  COMPLETE  CALC..  EXCEPT  FOR  RESETTING  ARRAYS 

2  ONLY  RESET  ARRAYS 
TO  5 


IT  (LS  .GT.  o)  GO 
KS  =  0 

ZAM=  mum 
CO=TSR (M, 15) 

TAUO=TSR (M, 16) 

TAUI=TSR (M, 17) 

ALF=TSP(M,18) 

DO  4  1=1.300 

TAUY(I)=TAUYMX(I)=EPMAXS(I)=EPMAXC(I)=EPDSV(I) 
1  T  AU ( 1 ) =0 . 

AMUSV ( I ) =ZAM 
.  CONTINUE 
LS  =  1 

IF  (IND  .EO.  2>  GO  TO 

ZTAUY=TAUY (J)  i 

ZEP=EP(J)  S 

ZEPSAVE  =  EPSAVE  ( J)  S 


=EPSAVE(I)=EP(I)= 


100 

ZTAUYMX=TAUYMX ( J) 
ZEPMAXC=EPMAXC ( j) 

zam=zamusv=mum  $ 


ZEPMAXS=EPMAXS ( J) 
ZEPOSV=EPDSV ( J) 

T  AUN  =  T  AU ( J ) 


tests  for  MATERIAL  EXCEEDING  MELT  energy 

IF  (ZEPMAXS  .LT.  0.)  GO  TO  90 
IF  (F.GT.O.)  GO  TO  10 
ZEPMAXS=-1 . 

sdh= o  • 

GO  TO  90 

**<*  TEST  FOR  INITIALIZING  SHEAR  STRtSS  CALCULATIONS 

IF  (ZEPMAXS  .GT.  0.)  GO  TO  20 
ENU  =  D/RHOS 

IF  ( A8S ( ENU- 1 . )  .GE.  l.E-6)  GO  TO  20 
TAUEL=0. 

GD  TO  70 

***  UPDATE  STRAIN  AND  ELASTIC  SHEAR  STRESS  AT  TIME(N+1)  *** 
20  KS=0 

VELS*-ALOG(D/DOLD> 

EEN=  ALOG(DOLD/RHOS) 

EENP1=EEN-VELS 

EPN=ZEP 

Z AMUS V  =  AM  INI ( Z AMUSV. AMA XI ( MUM- ALF* ABS ( EEN )  ,1. )  ) 
Cl=AMINl(ZAMUSV,AMAXl (ZAM-ALF*ABS (EENPl )*!.)) 

•  TAUEL=C1* (EENPl-l .S^EPN) 

IF  (ABS(EPN)  .LT.  l.E-6  .AND.  ABS(TAUN)  .LT.  TAUO)  EPN=0. 

TEST  1  -  TEST  FOR  EXCEEDING  ELASTIC  LIMIT  AT  TIME (N) 

IF  (ABS (ZEPMAXS)  .GT.  0.  .DR.  ABS(EPN)  .GT.  0.)  GO  TO  30 
TEST  2  -  TEST  FOR  EXCEEDING  ELASTIC  LIMIT  AT  TIME(NM) 
IF  (ABS(TAUEL)  .LT.  TAUO)  GO  TO  70 
***  INITIAL  CROSSING  OF  ELASTIC  LIMIT 


ALCOM 
STRESS 
STRLS2 
STRESS 
STRES2 
STRES2 1 0 
STHES21 1 
STRES? 1 2 
STHES21 3 
S  TRt  S2 1 4 
STRES215 
STRES216 
STRES2 1 7 
STRES2 1 8 
STRES219 
STRES220 
STRES  ?c:  1 
STRES222 
STRES223 
STRES224 
STRES22S 
STRES226 
STRES227 
ST  RES22H 

STRE. SPcy 
STRES230 
STRES231 
STRtS232 
STRES233 
STRES234 
STRES23S 
STRES236 
STRES237 
STRES238 
STRES239 
S  T  R  E  S  2  4  0 
STRES24 1 

STRF. S242 
STRES243 
STRES244 
STRES: 45 
STRES246 
STRES2**7 
STRES  ;48 
STRES249 
ST RES 2 SO 
STRES2S1 
STHES2S2 
STRES2S3 
STRFS254 
STRESSES 
STRES  c' 56 
STRES2d7 
STRES258 
STRES  >59 
STRES260 
STKES26I 
STRES262 
STRE.S^  b3 
STRLS264 
STRES,  -b5 
S  T  R  E  S  2  0  6 
STRES  ^67 
STRES/bB 


315 


OOO  -4000  OOOO  LTtOOOO  ^OOOO  OO  OOUIOOOO 


SUBROUTINE  STRES2  (Concluded) 


c 


0 


0 


60 


80 


90 

100 


KS=1 

GO  TO  60 


STRES/ 6 9 
STRES270 
STRESd/l 
STRES 2 72 


***  TEST  3  -  TEST  FOR  ELASTIC  OR  PLASTIC  CALCULATION  AT  STRESS 

TIME  CN*1 )  ***  STRES, 74 

STRES/ 75 

IF  (ABS(ZTAUYMX) .LT.ABS(TAUEL)  .AND.  TAUEL*Z T AU YMX . GE . 0 . )  GO  TO  40STRES276 

STRES/77 

***  TEST  4  -  TEST  FOR  CROSSING  FROM  ELASTIC  TO  PLASTIC  UNLOADING  STRES/7tl 


PHASE  ***  STRES279 

STRES280 

IF  ( T AUN* T AUEL  .GT.  0.)  GO  TO  50  STRFSPbl 

IF  (ABS (TAUN) .GT. ABS (ZTAUY)  .AND.  ABS ( ZT AU YMX ) . GT . 1 . )  GO  TO  50  S  TRES2B2 
KS=2  STKbSB63 

ZTAUYMX=0.  STRES/b* 

GO  TO  60  STRES265 

STRES286 

***  TEST  5  -  TEST  FOR  RELOADING  OR  REUNLOADING  FROM  AN  ELASTIC  STRES2B7 
POINT  AT  TIME ( N )  *«**  STHES2b8 

STRES?ei9 


IF  (ABS  (ZTAUYMX)  .GT.  ABS(ZTAUY))  KS  =  3  STRES290 

GO  TO  60  STRES/9 1 

STRES292 

***  TEST  b  -  TEST  FOR  FIRST  ELASTICALLY  CALCULATED  POINT  IN  STRES/93 

UNLOADING  PHASE  ***  STRES294 

STRES295 

IF  (ABS(TAUN)  .LE.  ABS(ZTAUY))  GO  TO  70  STRES'96 

KS=4  STRESc97 


STRES / 98 

***  CALL  BECOM  TO  CALCULATE  POINT  AT  T I  ME ( N+ 1 )  ON  A  PLASTIC  STRES/99 

LOADING  OR  UNLOADING  CURVE  ***  STRESlOO 


CALL  BECOM (D.SDH.DTNP1 .J.N) 

GO  TO  80 

***  POINT  AT  TIME ( N+ I )  IS  ON  ELASTIC  CURVE  *** 

ZTAUY=TAUEL 

SDHs4.*TAUEL/3. 

ZEPDS V  =  0  • 

***  UPDATE  TAUYMX  AT  TIME(N*1) 


ZT  AUYMX  =  AMAX 1 ( ABS ( ZTAUYMX ) , ABS (ZTAUY) )*SIGN(1. 

IH3=KS 

SDSTORE=SDH 

SDH=SDH«F 

IF  (IND  . EQ.  0)  GO  TO  100 
RETURN 

TAUY ( J) =ZTAUY  S 

EPMAXC ( J) =ZEPMAXC  $ 

AMUSV (J)=ZAMUSV  $ 


TAUYMX (J) =ZTAUYMX 
EPDSV(J)=ZEPDSV 
EP ( J ) *ZEP 


RETURN 

END 


ST  RES  101 
STRES 1  02 
STRES] 03 
STRES 1 04 
STRES105 
STRES 106 
STRES 1 07 
STRESlUb 
STRtSl 09 
STRES1 10 
STRES 1 1 1 
STRESi 12 

ZTAUY)  STRESi 13 

STRESi 14 
STRESi 15 
STRESi 16 
S  T RES |17 
STRESi 18 

EPMAXS ( J) =ZEPMAXS  STRESi 1 9 
EPSAVE ( J) =ZEPSAVE  STRES120 
TAU ( J) =.75«SDST0RESTRES1E1 
STRES 1 22 
STRESI 23 
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SUBROUTINE  TSQE 


FUNCTION  TSQE ( I P, PP, GRE, C,  D,  S, G, H, ES, ROS, EN, E , EQSTVM, EQSTAM 

, NCYC) 

TSQE 

2 

c 

C 

TSQE 

3 

c*  * 

CALCULATES  MU  OR  PTH  FROM  KNOWN  PRESSURE  AND  EOS  RELATION.  **C 

TSQE 

4 

c 

IP  *  0,  INVERSE  EOS.  IP  -  1,  INVERSE  EOS  FOR  PTH  =  ALFA*PST .  C 

TSQE 

5 

c 

C 

TSQE 

6 

NC  =  0  $  P0*=EMU0«P1  1  =0.  $  G2=G/2 

TSQE 

7 

ESUBC=1.0  $  ENN-0.5 

TSQE 

8 

IF  ( EQSTVM  , GT .  0.  .AND.  E  . GT .  ES)  ESUBC= 1 . +ALOG ( E/ES ) 

TSQE 

9 

IF  (EQSTVM  .NE.  0.)  ENN=ABS( EQSTVM) 

TSQE 

1  0 

ERAT  =  E/ES  $  IF  (E  . GT .  ES)  ERAT=1.0 

TSQE 

1  1 

EN2= ( EN+ERAT*EQSTAM) /ESUBC  $  ES2=ES*ESUBC 

TSQE 

1  2 

IF  (NC  .EQ.  0)  IXX-0 

TSQE 

1  3 

IF  (PP  .EQ.  0.  .AND.  E  . LT .  ES)  GO  TO  67 

TSQE 

14 

IND  =  I  P  +  1 

TSQE 

1  5 

IF  (PP  .LE.  GRE)  IND  =  I ND+2 

TSQE 

1  6 

EMU1  =  ( PP-GRE ) /C 

TSQE 

17 

8 

NC=NC+1  S  P 1 1 =P1 

TSQE 

1  8 

S4  =  0 . 

TSQE 

1  9 

GO  TO  (10,1 5, 20, 25)  IND 

TSQE 

20 

c 

PATH  FOR  COMPRESSION  -  SOLID  PRESSURE  KNOWN. 

*  *  c 

TSQE 

21 

1  0 

WMU  =  1 . +EMU1 

TSQE 

22 

PH  =  EMU1 *(C+EMU1 *(D+EMU1 *S) ) 

TSQE 

23 

PI  =  GRE+PH*( 1 . -G2*EMU1/WMU) 

TSQE 

24 

EMU2  =  TSQE  =  EMU1  +  ( PP-P1 ) * ( 0 . 5/ ( PH*G2/WMU*  *2+( C+EMU1 * ( 2 . *D+EMU1 *3 

TSQE 

25 

1 .  *S) )* ( 1 . -G2*EMU 1 /WMU ) ) +0 . 5* ( EMU1 -EMU0)/(P1 -PO)  ) 

TSQE 

26 

GO  TO  30 

TSQE 

27 

c 

PATH  FOR  EXPANSION  -  SOLID  PRESSURE  KNOWN. 

*  *  c 

TSQE 

28 

20 

WMU= 1 . +EMU1 

TSQE 

29 

SI =ROS*WMU 

TSQE 

30 

SQ  =  WMU*  *  ENN 

TSQE 

31 

S2=H+ ( G-H ) *SQ 

TSQE 

32 

IF  ( EN2*  EMU1 /WMU*  *2  . GT .  -30.)  S4  =  EXP ( EN2*EMU1 /WMU**2 ) 

TSQE 

33 

S3=E-ES2*( 1 . -S4 ) 

TSQE 

34 

PI =S1 *S2*S3 

TSQE 

35 

DPDMU=R0S*S2*S3+R0S*S3*ENN* ( G-H ) *SQ+R0S*S2*ES2*S4*EN2* (  1  . -EMU1 ) / 

TSQE 

36 

1  WMU*  *  2 

TSQE 

37 

EMU2=EMU1 + ( PP -PI ) /DPDMU 

TSQE 

38 

EMU2= AMAX1 ( -1 . +1 . E“8*NC, AMI N1 ( EMU2 , -1 ,E-8*NC) ) 

TSQE 

39 

GO  TO  30 

TSQE 

40 

C 

PATH  FOR  COMPRESSION  -  POROUS  PRESSURE  KNOWN. 

*  x  C 

TSQE 

41 

1  5 

WMU  a  1.+EMU1 

TSQE 

42 

ETA  =  1 . -G2#EMU1/WMU 

TSQE 

43 

PH  a  EMU1 * (C+EMU1 * (D+EMU1 *S) ) 

TSQE 

44 

PI  =  ( PH*ETA+GRE ) /WMU 

TSQE 

45 

EMU2  =  EMU1 + ( PP-P1 ) * ( 0 . 5/ ( ( ETA* ( C+EMU1 * ( 2 , *D+EMU1 #3#S) ) -PI -1 

PH*G2/ 

TSQE 

46 

1  WMU*  *  2 ) /WMU ) +0 . 5* ( EMU  1 -EMU0)/(P1 -PO) ) 

TSQE 

47 

GO  TO  30 

TSQE 

48 

C 

PATH  FOR  EXPANSION  -  POROUS  PRESSURE  KNOWN. 

*  x  c 

TSQE 

49 

25 

WMU  =  1 . +EMU1 

TSQE 

50 

SQsWMU*  *  ENN 

TSQE 

51 

S2=H+ ( G-H ) *SQ 

TSQE 

52 

IF  ( EN2* EMU1 /WMU* *2  . GT .  -30.)  S4  =  EXP ( EN2*EMU1 /WMU**2 ) 

TSQE 

53 

S3=E -ES2* ( 1 . -S4) 

TSQE 

54 

PI =R0S*S2*S3 

TSQE 

55 

DPDMU»R0S*S2*ES2*S4*  EN2* ( 1  .  -EMU1  ) /WMU* *3+R0S*S3* ( G-H ) *ENN*SQ/WMU 

TSQE 

56 

EMU2=EMU 1 + ( PP-P 1 ) /DPDMU 

TSQE 

57 

EMU2= AMAX1 (-1 .+1 . E-8*NC, AMI N1 ( EMU2, -1 .E-8*NC) ) 

TSQE 

58 

30 

CONTINUE 

TSQE 

59 

IF  (NC  .GT.  7)  PRINT  32, I P, PP, GRE , PI , EMU2, EMU1 , EMUO, NC, I XX 

TSQE 

60 

32 

FORMAT ( *  I P  =  *  I 3, *  PP, GRE, P1«*1P3E10.3,*  EMU2, EMU1 , EMUO  =  *  1 P3E 1 2 . 5, 

TSQE 

61 

1  *  NC,  I XX=  *213) 

TSQE 

62 

IF  (NC  .EQ.  10)  IXX=IXX+1  $  IF  ( I XX  . GT .  10)  STOP 

TSQE 

63 

IF  ( ABS ( EMU2 -EMU1 )  . GT .  1 . E-4*AMAX1 ( ABS( EMU1 ) , 1 . E-3) )  GOTO 

75 

TSQE 

64 

TSQE=EMU2 

TSQE 

65 

65 

IF  (IP  .EQ.  1)  TSQE=PTH=PP*( 1 . +EMU2) 

TSQE 

66 

67 

IF  (PP  .EQ.  0.)  TSQE=2*R0S/ ( 1 . +SQRT (1 . -4 . / ( EN+ERAT* EQSTAM ) *ALOG ( 1 . 

TSQE 

67 

1  -E/ES))) 

TSQE 

68 

70 

RETURN 

TSQE 

69 

75 

CONTINUE 

TSQE 

70 

IF  (NC  .EQ.  13)  GO  TO  65 

TSQE 

71 

IF  (ABS(PO-PP)  .LT.  ABS(PI-PP))  GO  TO  80 

TSQE 

72 

PO  =  PI  $  EMUO  *  EMU  1 

TSQE 

73 
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SUBROUTINE  TSQE  (Concluded) 


80  IF  (PP  .GT.  ORE)  SO  TO  90 

IF  (P11  .EQ.  0.  .OR.  (PI -PP) * ( PP-P1 1 )  .LE.  0.)  GO  TO  90 
EMU 1 ■ 0 . 5  * ( EMU 1 +EMU2 ) 

90  EMU1-EMU2 

95  GO  TO  8 

END 


TSQE 

74 

TSQE 

75 

TSQE 

76 

TSQE 

77 

TSQE 

78 

TSQE 

79 
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Appendix  J 


GLOSSARY 


Nomenclature  of  Text 


A 

w 

A. 

l 

a 


b 


C 

C. 

c 


c 

C 

e 


c 


D 


m 

P 


Atomic  weight,  g/mole 

Coefficients  of  the  fit  between  O  and  hv 

a  2 

Coefficient  of  Murnaghan  equation  for  pressure,  dyn/cm 

Number  of  cells  over  which  a  detonation  front  is 
spread,  or  dimensionless  coefficient  in  Murnaghan 
equation  for  pressure 

2 

Bulk  modulus,  dyn/cm 
-24  2 

10  cm  /barn,  a  conversion  factor 
4,186  x  107  erg/cal,  a  conversion  factor 
Effective  sound  speed,  cm/ sec 

An  effective  coefficient  of  artificial  viscosity 

Constant  in  linear  relation  between  shock  velocity 
and  particle  velocity,  cm/sec 

Specific  heat  at  constant  pressure,  dyn“Cm/g/°C 
Sound  speed,  cm/sec 

Coefficient  of  quadratic  artificial  viscosity 
Coefficient  of  linear  artificial  viscosity 

2 

Cohesion  or  shear  strength  at  zero  normal  stress,  dyn/cm 

3 

Density,  g/cm  ;  or  second  coefficient  in  series 
expansion  for  Hugoniot  pressure,  dyn/cm^ 

Detonation  velocity,  cm/sec 

Internal  energy,  erg/g 

Chapman-Jouguet  energy,  erg/g 

Effective  sublimation  energy  used  in  calculation 
of  expanded  states,  erg/g 

Melt  energy,  erg/g 
Plastic  energy,  erg/g 
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^rad 


F  .  >  F  ,  F 
ai  bi  ci 


G 

H 

h 

I 

I. 

J 


j 

k 


M 

Mi 

M. 


12 


CJ 

D 

'H 


Radiant  energy,  erg/g 
Sublimation  energy,  erg/g 
Thermal  reduction  factor 

Coefficients  in  the  thermal  reduction  series 
in  Appendix  D 

Fraction  of  explosive  detonated 

Thermal  softening  factor  applied  to  shear  modulus 

Thermal  softening  factor  applied  to  yield  strength 

2 

Shear  modulus,  dyn/cm 

Grilneisen  ratio  for  expanded  states 

—18 

Planck1 s  constant,  4.1354  x  10  keV-sec 
2 

Fluence,  cal/cm 

th 

Cumulative  impulse  fropj  the  front  up  to  the  j 
coordinate,  dyn-sec/cin 

2 

Incident  fluence  in  cal/cm 

°1  +  °2  +  a3’  F^rst  invariant  of  the  stress  tensor, 
dyn/ cm^ 

1/2  G^j  Gjj  ,  Second  invariant  of  the  deviator  stress 
tensor,  dyn^/cm^ 

Coordinate  or  cell  numbers 

Boltzmann’s  constant,  8.6164  x  10  eV/  K;  or  shear 
strength  constant  in  the  Coulomb  model  of  Drucker 
and  Prager,  dyn/cm^ 

2 

Work-hardening  modulus,  dyn/cm 
Mass  of  cell  1 

Momentum  between  coordinates  1  and  2 
23 

6.02252  x  10  ,  Avogadro’s  number,  atom/mole 

Number  of  cells  in  a  zone  or  number  of  constituents 
in  a  material 

tan^(45°  +  (J)/2)  ,  a  factor  appearing  in  Coulomb 
strength  calculations 

Time  step  (cycle)  number 

Pressure,  dyn/cm^ 

.  2 

Chapman-Jouguet  pressure,  dyn/cm 

2 

Hugoniot  pressure,  dyn/cm 

2 

Artificial  viscous  stress,  dyn/cm 
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X 


R 


R 


S 

T 


h 

AT 


n 


CJ 


CJ 


t 

U 

u 

u 

| 

V 

V 

I 

w 

X 

*D 

X 

AX 

AXf 

AXj 

V 


a 


Energy  of  an  explosive,  erg/g 

Total  mechanical  stress  in  direction  of 
propagation,  dyn/cm^ 

Geometric  ratio  between  successive  cells 

Radial  distance  in  cylindrical  or  spherical 
coordinates,  cm 

Third  coefficient  in  series  expansion  for 
Hugoniot  pressure,  dyn/cm^ 

Coefficient  in  linear  relation  between  shock 
velocity  and  particle  velocity 

Entropy,  erg/g/°C 

2 

Spall  strength,  dyn/cm;  or  Kelvin  temperature, 

°K;  or  time  constant  for  stress  relaxation,  sec 

Zone  thickness,  cm 

Duration  of  the  nth  source 

Problem  time,  sec 

Time  of  detonation,  sec 

Particle  velocity,  cm/sec 

Shock  velocity,  cm/sec 

Chapman-Jouguet  particle  velocity,  cm/sec 

3 

Specific  volume,  cm  /g 

3 

Chapman-Jouguet  specific  volume,  cm  / g 
ln(hV),  with  hV  in  keV 
Coordinate  location,  cm 

Point  of  initiation  of  a  detonation,  cm 
Midcell  location,  cm 

Cell  size  in  direction  of  propagation,  cm 

Last  cell  in  a  zone,  cm 

First  cell  in  a  zone,  cm 

2 

Yield  strength,  dyn/cm 

2  3 

Work-hardening  coefficient,  dyn/cm  /(g/cm  ) 

2 

Yield  stress  in  shear,  dyn/cm 

2 

Cell  mass  (g/cm  ,  g/cm,  or  g  for  planar,  cylindrical, 
or  spherical  flow) 

Volumetric  thermal  expansion  coefficient,  1/°C  or 
coefficient  in  the  Coulomb  model  of  Drucker  and 
Prager 
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Coulomb  coefficient  for  the  effect  of  pressure 
on  yield  strength 

Gruneisen's  ratio 

Effective  Griineisen  ratio  used  in  calculation 
of  expanded  states 

Shear  strain,  or  polytropic  gas  constant 

Added  change  in  thickness  between  successive 
cells  in  an  arithmetic  layout 

Kronecker  delta:  zero  for  i  f  j;  one  for  i  =  j 
1  -  pQ/p,  Lagrangian  strain 
Strain  tensor 


Component  of  the  elastic  strain  tensor 


Component  of  the  plastic  strain  tensor 
Y(2G),  strain  to  the  Hugoniot  elastic  limit 


Equivalent  plastic  strain,  defined  in  Eq.  (4.33) 

Temperature,  °C;  or  angle  between  the  radiation 
direction  and  normal  incidence  on  the  layer 

Small  angle  containing  the  typical  cell  in 
cylindrical  or  spherical  geometry 

Proportionality  factor  used  in  plasticity 
calculations,  cm^/dyn 

p/p  -  1,  a  strain 
o 

Linear  absorption  coefficient,  1/cm 
Vibration  frequency,  Hz 

Dimensionless  parabolic  interpolation  factors 
Density,  g/cm^ 

Initial  density 

Thermodynamic  stress  in  i  direction  on  j  plane,  dyn/cm 

2 

Deviator  stress  in  i  direction  on  j  plane,  dyn/cm 


Deviator  stress  computed  on  an  elastic  basis,  dyn/cm^ 

vr; 


Effective  stress, 


a. . 

ij  ij 


dyn/cm 


Effective  stress  based  on  elastically  computed  stresses, 
f3  .N  "  N  ,  ,  2 


N 


Mass  absorption  coefficient,  barns/atom 

2 

Normal  stress,  dyn/cm 

2 

Radial  stress,  dyn/cm 

2 

Circumferential  stress,  dyn/cm 

2 

Shear  stress,  dyn/cm 


T 

c 


<J> 


03 


2 

Shear  yield  stress,  dyn/cm 

Angle  of  internal  friction,  or  yield  function.  Yield 
occurs  for  <j)  =  0.  For  negative  values  of  cj),  behavior 
is  elastic;  positive  values  are  not  permitted. 

hv/KT,  a  nondimens ional  quantity  proportional 
to  photon  energy 
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Nomenclature  of  the  PUFF  code 


AK(M) 

2 

Initial  bulk  modulus  of  a  porous  material,  dyn/cm  (input) 

ANGLE 

Angle  between  the  direction  of  radiation  and  the  normal 
to  the  layers,  degrees  (input) 

BURN (M) 

Point  of  initiation  of  detonation,  cm  (input) 

CFP 

Abbreviated  symbol  for  the  indicators  NCMP(M),  NFR(M) , 
and  NPOR(M) 

CHL(J) 

Sound  speed,  cm/ sec 

CKS 

Maximum  distance  of  wave  front.  Computation  stops  if 
wave  reaches  CKS  (input) ,  cm 

COM 

Array  containing  additional  variables  for  special  material 
models;  see  Appendix  C 

COSQ 

Indicator  used  with  NYAM  (see  NYAM) 

COSQ(M) 

Coefficient  of  quadratic  artificial  viscosity  (input) 

Cl  (M) 

Coefficient  of  linear  artificial  viscosity  in 
compression  (input) 

C2(M) 

Coefficient  of  linear  artificial  viscosity  in  tension  (input) 

DELFIN 

Size  of  the  last  cell  in  a  zone,  cm.  Used  for  arithmetic 
cell  layout  (input) 

DELTIM 

Calculational  time  for  a  cycle,  sec 

DELX 

Size  of  the  first  cell  in  a  zone,  cm.  Used  for  arithmetic 
and  geometric  cell  layout  (input) 

DET (M) 

Detonation  velocity  of  an  explosive,  cm/sec 

DHL(J) 

3 

Cell  density,  g/cm 

DIST(M) 

Number  of  cells  over  which  a  detonation  front  is  spread, 
cm  (input) 

DPY 

Abbreviated  symbol  for  the  indicators  NDS(M),  NPR(M) , 
and  NYAM 

DTN 

Previous  time  increment  in  the  calculation,  sec 

DTNH 

Current  time  increment  in  the  calculation,  sec 

DTMAX 

Time  step  desired  after  automatic  rezoning,  sec.  If 
negative,  |DTMAx|  is  the  number  of  cells  desired  in 
the  layer  numbered  |NREZON|  (input) 

ECAL 

2 

Fluence,  cal/cm  (input) 

EC  J  (M) 

Chapman- jouguet  energy,  erg/g 

EHL(J) 

Internal  energy,  erg/g 

El 

Energy  at  a  specific  photon  energy  in  an  arbitrary 
spectrum,  cal/cm^  (input) 
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EMELT 
EMELT (M) 
EQSTC(M) 

EQSTD(M) 

EQSTE(M) 

EQSTG(M) 

EQSTH(M) 

EQSTS(M) 


EXMAT  (M,  I) 


FBURN 

GMELT 


J 

JBND(L) 

JCYCS 

JFIN 

JMAT(L) 

JREZON 

JSTAR 

JTS 

LSUB (  ) 


Indicator  used  with  NYAM  (see  NYAM) 

Internal  energy  at  melting,  erg/g  (input) 

2 

Bulk  modulus,  dyn/cm  .  Read  in  as  C  for  C,D,S  Hugoniot 
pressure  form,  CL  for  the  linear  Us  -  U  form,  or  a/b  for 
the  Murnaghan  form  (input) 

Second  coefficient  in  the  expansion  for  Hugoniot  pressure, 
dyn/cm2.  Read  in  as  D  for  C,D,S  form,  SL  for  the  linear 
U  -  U  form,  or  b  for  the  Murnaghan  form  (input) 

Sublimation  energy,  erg/g  (input) 

Griineisen  ratio  (input) 

Gruneisen  ratio  for  expanded  states  (input) 

Third  coefficient  in  the  expansion  for  Hugoniot  pressure, 
dyn/cm2.  Read  in  as  S  for  C,D,S  form,  1.0  for  Murnaghan 
or  2.0  for  linear  U  -  U  form  (input) 

Array  containing  additional  property  data 
1=1  contains  Coulomb  coefficient  (input) 

1=3  contains  initial  sound  speed  of  porous 
material  or  explosive 

Fraction  of  explosive  detonated 

Indicator  used  with  NYAM  (see  NYAM) 

Indicator  arrays.  H(J,1)  indicates  solid  or  porous 
state;  H(J,2)  shows  coordinate  type  and  path  to  be 
followed  in  HYDRO:  H(J,3)  indicates  the  material 
state  in  the  cell 

Coordinate  or  cell  number 

Final  J  value  of  the  Lth  layer 

Number  of  calculational  cycles  at  which  computation  will 
terminate  (input).  If  JCYCS  is  set  to  zero,  only  a 
layout  is  performed 

Last  coordinate  value,  equals  last  cell  number  +  2 

Material  number  in  layer  L.  JMAT(L)  =  0  if  the  Lth 
layer  is  a  gap  (input) 

Rightmost  coordinate  of  a  nonautomatic  rezone  (input) 

The  J  value  of  the  right-most  active  cell 

J  value  of  cell  governing  time  step.  In  SCRIBE  histories, 
JTS  is  listed  as  JTS  plus  1000  times  the  number  of  spalled 
interfaces 

Indicator  array,  mainly  used  for  initializing  special 
material  model  subroutines.  LSUB(7)  is  set  to  1  at 
several  places  in  the  program  to  halt  calculations 
because  of  an  error 
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LVAR(J) 

Array  containing  starting  location  of  additional  variables 
for  cell  J  in  the  COM  array;  see  Appendix  C 

M 

Material  number 

MATFL 

Indicator  for  problem  type  (input) .  MATFL  >  0  means  impact 
or  explosion  and  MATFL  is  the  last  layer  in  the  flyer  plate 
MATFL  =  0.  Radiation  deposition 

MATFL  -  -1  Mirror  or  symmetric  impact 

MATFL  =  -2  Pressure  boundary  at  J  =  1 

MATFL  =  -3  Pressure  boundary  at  J  =  JFIN 

MATL 

Array  containing  the  material  name  (input) 

MELT 

Indicator  used  with  NYAM  (see  NYAM) 

MU  (M) 

2 

Shear  modulus,  dyn/cm  (input) 

MUP(M) 

2 

Initial  shear  modulus  in  porous  material,  dyn/cm  (input) 

N 

Current  calculation  cycle 

NALPHA 

Geometry  indicator:  0  or  1  for  planar,  2  for  cylindrical, 
and  3  for  spherical  (input) 

NARB 

Indicator  for  an  arbitrary  deposition  (depth-dose  profile) , 
(input) 

0  Normal  operation 

1  Normalize  energy  to  the  ECAL  designated 

-I  Modify  X-scale  to  fit  the  present  density  (I  is  arbitrary) 
-1  Modify  X-scale  to  fit  the  present  density  and  normalize 
to  the  ECAL  designated 

NARZ 

Maximum  number  of  automatic  rezones  (input) 

NBB 

Number  of  black  bodies  in  a  spectrum  (input) 

NCELLS 

Number  of  cells  in  a  zone  (input) 

NCMP  (M) 

Indicator  for  a  model  for  a  composite  material:  zero 
for  no  model,  1  for  REBAR  (input) 

NCON  (M) 

Indicator  for  number  of  constituents  in  a  mixture  or 
compound.  Used  for  radiation  absorption  calculations 
only  (input) 

NDS(M) 

Indicator  for  a  deviator  stress  model:  zero  for  standard 
model  (Section  4),  1  for  one-parameter  stress  relaxation 
model,  2  for  Band  dislocation  model,  3  for  Gilman  dis¬ 
location  model,  4  for  two-parameter  stress  relaxation 
model,  5  for  Bauschinger  model,  6  for  Read  relaxation 
model  for  beryllium  (input) 

NEDIT 

j 

Number  of  cycles  between  calls  to  EDIT.  EDIT  calls  may  be 
controlled  by  either  TEDITs  or  NEDIT,  or  by  both 

NEM(J) 

Number  of  mobile  dislocations  or  relative  void  volume 

NET ( J) 

3 

Total  number  of  dislocations  or  number  of  voids/cm 

NFR(M) 

Indicator  for  a  fracture  model:  zero  for  no  model,  1  for 
DFRACT ,  2  for  BFRACT,  3  for  SHEAR2 ,  and  4  for  both  BFRACT 
and  SHEAR2  (input) 
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NJEDIT 

Number  of  lines  of  data  in  the  request  for  historical 
listings  (input) 

NHNU 

Number  of  energy  values  in  an  arbitrary  spectrum  (input) 

NLAYER 

Number  of  layers,  counting  blank  layers  or  gaps.  A  hollow 
cylinder  or  sphere  is  represented  with  a  gap  as  the  first 
layer  (input) 

NMTRLS 

Number  of  materials  for  which  data  are  supplied  in  the 
problem  input  (input) 

NPOINT 

Number  of  points  in  a  depth-dose  profile  (input) 

NPOR(M) 

Indicator  for  a  porous  material:  zero  for  no  model,  1  for 
POREQST,  2  for  PORHOLT,  3  for  PEST,  and  4  for  CAP  (input) 

NPR(M) 

Indicator  for  pressure  model:  zero  for  EQST,  1  for  explosive, 

2  for  ESA,  3  for  Philco-Ford  equation  of  state,  4  for  variable 
modulus  model  (HYPO) ,  5  for  GRAY  equation  of  state,  6  for 
tabular  equation  of  state,  and  7  for  a  linear  equation  of 
state  provided  in  HAFSTEP  (input) 

NREZON 

Rezone  control  parameter.  For  positive  values,  NREZON 
means  the  number  of  rezones  requested.  A  negative  NREZON 
indicates  automatic  rezoning.  See  Section  5.2  for  further 
information  on  rezone  controls  (input) 

NSCRB 

An  array  of  indicators  for  controlling  radiation  deposition 
plots  from  DEPOS  (input) 

NSPEC 

Number  of  spectra  (input) 

NTEDT 

Number  of  time  edits  requested  at  specified  times  (input) 

NTR 

Number  of  the  TEDIT  for  which  a  rezone  is  requested  (input) 

NVAR(M) 

Number  of  extra  variables  required  for  each  cell  for  the 
material  model  being  used.  Current  models  and  extra 
variables  required  are:  BFRACT2  (11),  BFRACT3  (20),  HYPO  (3), 
PEST  (5),  REBAR  (7),  and  SHEAR2  (variable)  (input) 

NY  AM 

Indicator  for  the  number  of  lines  containing  spall  strength, 
viscosity,  thermal  strength  reduction,  and  yield  data.  The 
first  word  on  each  of  these  lines  contain  letters  showing 
the  data  type  (input) 

C  (COSQ)  or  V  (VISC) :  artificial  viscosity 

E  (EMELT)  or  M  (MELT) :  thermal  strength  reduction  factor 

GM  (GMELT) :  thermal  reduction  for  shear  modulus 

T  (TENS) :  spall  strength 

Y  (YIELD) :  yield  strength,  shear  modulus,  work-hardening 
modulus 

NZONES 

Number  of  zones  in  a  layer  (input) 

PC  J  (m) 

.  2 

Chapman-Jouguet  pressure  dyn/cm 

PHL(J) 

2 

Pressure,  dyn/cm  (positive  in  compression) 
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U(J) 

Particle  velocity,  cm/sec 

UZERO 

Flyer  velocity,  cm/sec  (input) 

VCJ  (M) 

3 

Chapman-Jouguet  specific  volume,  cm  /g 

vise 

Indicator  used  with  NYAM  (see  NYAM) 

X(J) 

Euler ian  location  of  coordinate  J,  cm 

YADD (M) 

2 

Work-hardening  coefficient,  dyn/cm  during  input  and 
dyn/cm^/ (g/cm^)  after  resetting  in  GENRAT  (input) 

YHL(J) 

Yield  strength 

YIELD 

Indicator  used  with  NYAM  (see  NYAM) 

YOS 

2 

Initial  yield  strength,  dyn/cm  (input) 

ZHL(J) 

2 

Cell  mass;  g/cm  ,  g/cm,  or  g  for  planar,  cylindrical, 
or  spherical  geometry 
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P6 

Pressure  coefficient  in  prescribed  exponential  pressure 
boundary.  P6(l^|  is  ^or  boundary,  P6(2)  for  right 

(input),  dyn/cni 

QEXPL(M) 

Energy  of  an  explosive,  erg/g  (input) 

RATIO 

Geometric  ratio  used  for  geometric  cell  layout  (input) 

RHL(J) 

2 

Mechanical  stress  in  the  direction  of  propagation,  dyn/cm 
(positive  in  compression) 

RHO(M) 

3 

Initial  cell  density,  g/cm  (input) 

RHOS (M) 

3 

Initial  solid  density,  g/cm  (input) 

SDH 

2 

Deviator  stress  in  the  direction  of  propagation,  dyn/cm 
(positive  in  compression) 

SDT(J) 

Deviator  stress  in  the  transverse  (circumferential) 
direction  in  cylindrical  geometry,  dyn/cm 

SDURM 

An  indicator  for  radiation  calculations.  Set  to  the  longest 
duration  of  an  active  radiation  source  during  radiation; 
reset  to  1.0  after  radiation  is  complete,  sec 

SHL(J) 

2 

Stress  in  direction  of  propagation,  dyn/cm  (positive  in 
compression) 

SS 

Spectral  energy  that  is  gradually  deposited  into  the  cells 
during  radiation 

SSTOPM 

Maximum  stop  time  for  radiation  deposition,  sec 

SSTOP(N) 

Stop  time  of  Nth  radiation  source,  sec  (input) 

START (N) 

Start  time  of  Nth  radiation  source,  sec  (input) 

T(J) 

2 

Spall  strength,  dyn/cm  (negative) 

TARZ 

Problem  time  when  automatic  rezoning  is  terminated,  sec  (input) 

TBL 

hV,  photon  energy,  keV  (input) 

TEDIT 

Specified  time  at  which  an  edit  is  requested  (input) ,  sec 

TEMP 

Black  body  temperature,  keV  (input) 

TENS 

Indicator  used  with  NYAM  (see  NYAM) 

TENS (M,  I) 

2 

Spall  strength,  dyn/cm  (input) , 

1=1  for  solid 

1=2  for  porous 

1=3  for  interface  with  following  material 

TH 

Zone  thickness,  cm  (input) 

TIME 

Current  time  in  the  problem,  sec 

TREZON 

Time  interval  between  automatic  rezones,  sec  (input) 

TS 

Stop  time  for  the  problem,  sec  (input) 

TSR 

Array  used  for  deviator  stress  and  fracture  properties  (input) 

T6 

Time  factor  in  prescribed  exponential  pressure  boundary. 

T6(l)  is  for  left  boundary,  T6(2)  for  right  (input),  sec 
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